Project

General

Profile

Revision 5fccce23

View differences:

src/backends/C/c_backend_common.ml
470 470
    name
471 471
    (Utils.fprintf_list ~sep:",@ " pp_c_decl_input_var) inputs
472 472
    
473
let print_import_init fmt (Dep (local, basename, _, _)) =
474
  if local then
475
    let baseNAME = file_to_module_name basename in
473
let print_import_init fmt dep =
474
  if dep.local then
475
    let baseNAME = file_to_module_name dep.name in
476 476
    fprintf fmt "%a();" pp_global_init_name baseNAME
477 477
  else ()
478 478

  
479
let print_import_clear fmt (Dep (local, basename, _, _)) =
480
  if local then
481
    let baseNAME = file_to_module_name basename in
479
let print_import_clear fmt dep =
480
  if dep.local then
481
    let baseNAME = file_to_module_name dep.name in
482 482
    fprintf fmt "%a();" pp_global_clear_name baseNAME
483 483
  else ()
484 484

  
485
let print_import_prototype fmt (Dep (_, s, _, _)) =
486
  fprintf fmt "#include \"%s.h\"@," s
485
let print_import_prototype fmt dep =
486
  fprintf fmt "#include \"%s.h\"@," dep.name
487 487

  
488
let print_import_alloc_prototype fmt (Dep (_, s, _, stateful)) =
489
  if stateful then
490
    fprintf fmt "#include \"%s_alloc.h\"@," s
488
let print_import_alloc_prototype fmt dep =
489
  if dep.is_stateful then
490
    fprintf fmt "#include \"%s_alloc.h\"@," dep.name
491 491

  
492
let print_extern_alloc_prototypes fmt (Dep (_,_, header,_)) =
492
let print_extern_alloc_prototypes fmt dep =
493 493
  List.iter (fun decl -> match decl.top_decl_desc with
494 494
  | ImportedNode ind when not ind.nodei_stateless ->
495 495
    let static = List.filter (fun v -> v.var_dec_const) ind.nodei_inputs in
......
498 498
      fprintf fmt "extern %a;@.@." print_dealloc_prototype ind.nodei_id;
499 499
    end
500 500
  | _                -> ()
501
  ) header
501
  ) dep.content
502 502

  
503 503

  
504 504
let pp_c_main_var_input fmt id =  
src/backends/C/c_backend_header.ml
391 391
    (* Import the header *)
392 392
    fprintf header_fmt "/* Import header from %s */@." basename;
393 393
    fprintf header_fmt "@[<v>";
394
    print_import_prototype header_fmt (Dep (true, basename, [], true (* assuming it is staful *) ));
394
    print_import_prototype header_fmt {local=true; name=basename; content=[]; is_stateful=true} (* assuming it is staful *);
395 395
    fprintf header_fmt "@]@.";
396 396
    fprintf header_fmt "/* Import dependencies */@.";
397 397
    fprintf header_fmt "@[<v>";
......
434 434
    List.iter
435 435
      (fun dep -> 
436 436
	let (local, s) = dependency_of_top dep in 
437
	print_import_prototype header_fmt (Dep (local, s, [], true (* assuming it is stateful *))))
437
	print_import_prototype header_fmt {local=local; name=s; content=[]; is_stateful=true} (* assuming it is stateful *))
438 438
      dependencies;
439 439
    fprintf header_fmt "@]@.";
440 440
    fprintf header_fmt "/* Types definitions */@.";
src/backends/C/c_backend_main.ml
164 164
let print_main_c main_fmt main_machine basename prog machines _ (*dependencies*) =
165 165
  print_main_header main_fmt;
166 166
  fprintf main_fmt "#include <stdlib.h>@.#include <assert.h>@.";
167
  print_import_alloc_prototype main_fmt (Dep (true, basename, [], true (* assuming it is stateful*) ));
167
  print_import_alloc_prototype main_fmt {local=true; name=basename; content=[]; is_stateful=true} (* assuming it is stateful*) ;
168 168
  pp_print_newline main_fmt ();
169 169

  
170 170
  (* Print the svn version number and the supported C standard (C90 or C99) *)
src/backends/C/c_backend_makefile.ml
13 13
open Lustre_types
14 14
open Corelang
15 15

  
16
let pp_dep fmt (Dep(b,id,tops,stateful)) =
16
let pp_dep fmt dep =
17 17
  Format.fprintf fmt "%b, %s, {%a}, %b"
18
    b id Printers.pp_prog tops stateful
18
    dep.local dep.name Printers.pp_prog dep.content dep.is_stateful
19 19
  
20 20
let pp_deps fmt deps = Format.fprintf fmt "@[<v 0>%a@ @]" (Utils.fprintf_list ~sep:"@ ," pp_dep) deps
21 21

  
......
37 37
  ) [] header 
38 38
    
39 39

  
40
let compiled_dependencies dep = 
41
  List.filter (fun (Dep (_, _, header, _)) -> header_has_code header) dep
40
let compiled_dependencies deps = 
41
  List.filter (fun dep -> header_has_code dep.content) deps
42 42

  
43
let lib_dependencies dep = 
43
let lib_dependencies deps = 
44 44
  List.fold_left 
45
    (fun accu (Dep (_, _, header, _)) -> Utils.list_union (header_libs header) accu) [] dep
45
    (fun accu dep -> Utils.list_union (header_libs dep.content) accu) [] deps
46 46
    
47
let fprintf_dependencies fmt (dep: dep_t list) =
47
let fprintf_dependencies fmt (deps: dep_t list) =
48 48
  (* Format.eprintf "Deps: %a@." pp_deps dep; *)
49
  let compiled_dep = compiled_dependencies dep in
49
  let compiled_deps = compiled_dependencies deps in
50 50
  (* Format.eprintf "Compiled Deps: %a@." pp_deps compiled_dep; *)
51 51
 
52 52
  List.iter (fun s -> Log.report ~level:1 (fun fmt -> fprintf fmt "Adding dependency: %s@." s);  
53 53
    fprintf fmt "\t${GCC} -I${INC} -c %s@." s)
54 54
    (("${INC}/io_frontend.c"):: (* IO functions when a main function is computed *)
55 55
	(List.map 
56
	   (fun (Dep (local, s, _, _)) -> 
57
	     (if local then s else Version.include_path ^ "/" ^ s) ^ ".c")
58
	   compiled_dep))
56
	   (fun dep -> 
57
	     (if dep.local then dep.name else Version.include_path ^ "/" ^ dep.name) ^ ".c")
58
	   compiled_deps))
59 59

  
60 60
module type MODIFIERS_MKF =
61 61
sig (* dep was (bool * ident * top_decl list) *)
......
108 108
    fprintf fmt "\t${GCC} -I${INC} -I. -c %s_main.c@." basename;   
109 109
    fprintf_dependencies fmt dependencies;    
110 110
    fprintf fmt "\t${GCC} -o ${BINNAME} io_frontend.o %a %s.o %s_main.o %a@." 
111
      (Utils.fprintf_list ~sep:" " (fun fmt (Dep (_, s, _, _)) -> Format.fprintf fmt "%s.o" s)) 
111
      (Utils.fprintf_list ~sep:" " (fun fmt dep -> Format.fprintf fmt "%s.o" dep.name)) 
112 112
      (compiled_dependencies dependencies)
113 113
      basename (* library .o *)
114 114
      basename (* main function . o *) 
src/backends/C/c_backend_mauve.ml
33 33

  
34 34
let print_mauve_header fmt mauve_machine basename prog machines _ (*dependencies*) =
35 35
  fprintf fmt "#include \"mauve/runtime.hpp\"@.";
36
  print_import_alloc_prototype fmt (Dep (true, basename, [], true (* assuming it is stateful*) ));
36
  print_import_alloc_prototype fmt {local=true; name=basename; content=[]; is_stateful=true} (* assuming it is stateful*) ;
37 37
  pp_print_newline fmt ();
38 38
  pp_print_newline fmt ()
39 39

  
src/backends/C/c_backend_spec.ml
158 158
  C_backend_makefile.fprintf_dependencies fmt dependencies; 
159 159
  fprintf fmt "\t${GCC} -Wno-attributes -o %s_main_eacsl io_frontend.o %a %s %s_main_eacsl.o %a@." 
160 160
    basename 
161
    (Utils.fprintf_list ~sep:" " (fun fmt (Dep (_, s, _, _)) -> Format.fprintf fmt "%s.o" s)) 
161
    (Utils.fprintf_list ~sep:" " (fun fmt dep -> Format.fprintf fmt "%s.o" dep.name)) 
162 162
    (C_backend_makefile.compiled_dependencies dependencies)
163 163
    ("${FRAMACEACSL}/e_acsl.c " 
164 164
     ^ "${FRAMACEACSL}/memory_model/e_acsl_bittree.c " 
src/backends/C/c_backend_src.ml
271 271
  let imported_node_opt = (* We select the last imported node with the name funname.
272 272
			       The order of evaluation of dependencies should be
273 273
			       compatible with overloading. (Not checked yet) *) 
274
      List.fold_left
275
	(fun res (Dep (_, _, decls, _)) -> 
276
	  match res with
277
	  | Some _ -> res
278
	  | None -> 
279
	    let matched = fun t -> match t.top_decl_desc with 
280
	      | ImportedNode nd -> nd.nodei_id = funname 
281
	      | _ -> false
282
	    in
283
	    if List.exists matched decls then (
284
	      match (List.find matched decls).top_decl_desc with
285
	      | ImportedNode nd -> Some nd
286
	      | _ -> assert false
287
	    )
288
	    else
289
	      None
290
	) None dependencies in
291
    match imported_node_opt with
292
    | None -> false
293
    | Some nd -> (match nd.nodei_prototype with Some "C" -> true | _ -> false)
274
    List.fold_left
275
      (fun res dep -> 
276
	match res with
277
	| Some _ -> res
278
	| None ->
279
           let decls = dep.content in
280
	   let matched = fun t -> match t.top_decl_desc with 
281
	                          | ImportedNode nd -> nd.nodei_id = funname 
282
	                          | _ -> false
283
	   in
284
	   if List.exists matched decls then (
285
	     match (List.find matched decls).top_decl_desc with
286
	     | ImportedNode nd -> Some nd
287
	     | _ -> assert false
288
	   )
289
	   else
290
	     None
291
      ) None dependencies in
292
  match imported_node_opt with
293
  | None -> false
294
  | Some nd -> (match nd.nodei_prototype with Some "C" -> true | _ -> false)
294 295
(*
295 296
let pp_instance_call dependencies m self fmt i (inputs: value_t list) (outputs: var_decl list) =
296 297
  try (* stateful node instance *)
......
687 688

  
688 689
let print_lib_c source_fmt basename prog machines dependencies =
689 690
  print_import_standard source_fmt;
690
  print_import_prototype source_fmt (Dep (true, basename, [], true (* assuming it is stateful *)));
691
  print_import_prototype source_fmt {local=true; name=basename; content=[]; is_stateful=true} (* assuming it is stateful *);
691 692
  pp_print_newline source_fmt ();
692 693
  (* Print the svn version number and the supported C standard (C90 or C99) *)
693 694
  print_version source_fmt;
src/checks/algebraicLoop.ml
144 144

  
145 145
  (* Mini stage 1 *)
146 146
  (* Extracting dependencies: fill some table with typing info *)
147
  ignore (Compiler_common.import_dependencies prog);
147
  ignore (Modules.load ~is_header:false prog);
148 148
  (* Local inlining *)
149 149
  let prog = Inliner.local_inline prog (* type_env clock_env *) in
150 150
  (* Checking stateless/stateful status *)
src/compiler_common.ml
153 153
  let new_cenv = clock_decls Basic_library.clock_env header in   (* Clock calculus *)
154 154
  header, new_tenv, new_cenv
155 155

  
156
let get_envs_from_const const_decl (ty_env, ck_env) =
157
  (Env.add_value ty_env const_decl.const_id const_decl.const_type,
158
   Env.add_value ck_env const_decl.const_id (Clocks.new_var true))
159

  
160
let get_envs_from_consts const_decls (ty_env, ck_env) =
161
  List.fold_right get_envs_from_const const_decls (ty_env, ck_env)
162

  
163
let rec get_envs_from_top_decl (ty_env, ck_env) top_decl =
164
 match top_decl.top_decl_desc with
165
 | Node nd          -> (Env.add_value ty_env nd.node_id nd.node_type,
166
			Env.add_value ck_env nd.node_id nd.node_clock)
167
 | ImportedNode ind -> (Env.add_value ty_env ind.nodei_id ind.nodei_type,
168
			Env.add_value ck_env ind.nodei_id ind.nodei_clock)
169
 | Const c          -> get_envs_from_const c (ty_env, ck_env)
170
 | TypeDef _        -> List.fold_left get_envs_from_top_decl (ty_env, ck_env) (consts_of_enum_type top_decl)
171
 | Open _           -> (ty_env, ck_env)
172

  
173
(* get type and clock environments from a header *)
174
let get_envs_from_top_decls header =
175
  List.fold_left get_envs_from_top_decl (Env.initial, Env.initial) header
176 156

  
177 157
(*
178 158
 List.fold_right
......
226 206
      Location.pp_loc loc;
227 207
    raise exc
228 208

  
229
let is_stateful topdecl =
230
  match topdecl.top_decl_desc with
231
  | Node nd -> (match nd.node_stateless with Some b -> not b | None -> not nd.node_dec_stateless)
232
  | ImportedNode nd -> not nd.nodei_stateless 
233
  | _ -> false
234

  
235
(* Beware of the side effect: reads and modifies Global.(type_env/clock_env) *)
236
let rec import_dependencies prog : dep_t list =
237
  Log.report ~level:1 (fun fmt -> fprintf fmt "@[<v 4>.. extracting dependencies");
238
  let dependencies = Corelang.get_dependencies prog in
239
  let (compilation_deps, type_env, clock_env) =
240
  List.fold_left
241
    (fun (compilation_dep, type_env, clock_env) dep ->
242
      let (local, s) = Corelang.dependency_of_top dep in
243
      let basename = Options_management.name_dependency (local, s) in
244
      Log.report ~level:1 (fun fmt -> Format.fprintf fmt "@ Library %s@ " basename);
245
      let lusic = Modules.import_dependency dep.top_decl_loc (local, s) in
246
      (*Log.report ~level:1 (fun fmt -> Format.fprintf fmt "");*)
247
      let lusic_deps = import_dependencies lusic.Lusic.contents in
248
      let (lusi_type_env, lusi_clock_env) = get_envs_from_top_decls lusic.Lusic.contents in
249
      let is_stateful = List.exists is_stateful lusic.Lusic.contents in
250
      let new_dep = Dep (local, s, lusic.Lusic.contents, is_stateful ) in
251
      new_dep::lusic_deps@compilation_dep,
252
      Env.overwrite type_env lusi_type_env,
253
      Env.overwrite clock_env lusi_clock_env)
254
    ([], !Global.type_env, !Global.clock_env)
255
    dependencies in
256
  Global.type_env := type_env; 
257
  Global.clock_env := clock_env;
258
  begin
259
    Log.report ~level:1 (fun fmt -> fprintf fmt "@]@ ");
260
    compilation_deps
261
  end
262 209

  
263 210
let track_exception () =
264 211
  if !Options.track_exceptions
src/compiler_stages.ml
36 36
      else
37 37
	begin
38 38
	  Log.report ~level:1 (fun fmt -> fprintf fmt ".. loading compiled header file %s@," header_name);
39
	  Modules.check_dependency lusic destname;
39
	  Lusic.check_obsolete lusic destname;
40 40
	  let header = lusic.Lusic.contents in
41
	  let (declared_types_env, declared_clocks_env) = get_envs_from_top_decls header in
41
	  let (declared_types_env, declared_clocks_env) = Modules.get_envs_from_top_decls header in
42 42
	  check_compatibility
43 43
	    (prog, computed_types_env, computed_clocks_env)
44 44
	    (header, declared_types_env, declared_clocks_env)
......
56 56
  Log.report ~level:4 (fun fmt -> fprintf fmt ".. after automata expansion:@,  @[<v 2>@,%a@]@ " Printers.pp_prog prog);
57 57

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

  
61
  (* Extracting dependencies (and updating Global.(type_env/clock_env) *)
62
  let dependencies = import_dependencies prog in
61
  (* Registering types and clocks for future checks *)
62
  Global.type_env := Env.overwrite !Global.type_env typ_env;
63
  Global.clock_env := Env.overwrite !Global.clock_env clk_env;
64
  
65
  (* (\* Extracting dependencies (and updating Global.(type_env/clock_env) *\)
66
   * let dependencies = import_dependencies prog in *)
63 67

  
64 68
  (* Sorting nodes *)
65 69
  let prog = SortProg.sort prog in
src/lustre_types.ml
228 228

  
229 229
type program_t = top_decl list
230 230

  
231
type dep_t = Dep of
232
    bool
233
  * ident
234
  * (top_decl list)
235
  * bool (* is stateful *)
236

  
231
type dep_t = {
232
    local: bool;
233
    name: ident;
234
    content: program_t;
235
    is_stateful: bool
236
  }
237 237

  
238 238

  
239 239

  
src/main_lustre_compiler.ml
42 42
  begin
43 43
    Log.report ~level:1 (fun fmt -> fprintf fmt "@[<v>");
44 44
    let header = parse_header true (dirname ^ "/" ^ header_name) in
45
    ignore (Modules.load ~is_header:true ISet.empty header);
45
    (* Disbaled today, should be done anyway when following the regular compilation 
46
ignore (Modules.load ~is_header:true ISet.empty header); *)
46 47
    ignore (check_top_decls header); (* typing/clocking with an empty env *)
47 48
    create_dest_dir ();
48 49
    Log.report ~level:1
49 50
      (fun fmt -> fprintf fmt ".. generating compiled header file %sc@," (destname ^ extension));
50 51
    Lusic.write_lusic true header destname lusic_ext;
51 52
    generate_lusic_header destname lusic_ext;
53

  
54

  
55

  
52 56
    Log.report ~level:1 (fun fmt -> fprintf fmt ".. done !@ @]@ ")
53 57
  end
54 58

  
src/main_lustre_testgen.ml
56 56
  if !Options.gen_mcdc then (
57 57
    let prog_mcdc = PathConditions.mcdc prog in
58 58
    (* We re-type the fresh equations *)
59
    let _ = import_dependencies prog_mcdc in
59
    let _ = Modules.load ~is_header:false prog_mcdc in
60 60
    let _ = type_decls !Global.type_env prog_mcdc in
61 61

  
62 62
    let destname = !Options.dest_dir ^ "/" ^ basename in
src/modules.ml
23 23
 then raise (Error (loc, Error.Unbound_symbol msg))
24 24
 else ()
25 25

  
26

  
26 27
let add_imported_node name value =
27 28
(*Format.eprintf "add_imported_node %s %a (owner=%s)@." name Printers.pp_imported_node (imported_node_of_top value) value.top_decl_owner;*)
28 29
  try
......
122 123
    lusic
123 124
  with
124 125
  | Sys_error msg ->
125
    begin
126
      (*Format.eprintf "Error: %s@." msg;*)
127 126
      raise (Error (loc, Error.Unknown_library basename))
128
    end
129
  | Corelang.Error (_, msg) -> raise (Corelang.Error (loc, msg))
130

  
127
    
131 128
let import_dependency loc (local, dep) =
132 129
  try
133 130
    import_dependency_aux loc (local, dep)
......
139 136
    raise exc
140 137
  )
141 138

  
142
let check_dependency lusic basename =
143
  try
144
    Lusic.check_obsolete lusic basename
145
  with
146
  | Corelang.Error (loc, err) as exc -> (
147
    Format.eprintf "Import error: %a%a@."
148
      Error.pp_error_msg err
149
      Location.pp_loc loc;
150
    raise exc
139
let get_lusic decl =
140
  match decl.top_decl_desc with
141
  | Open (local, dep) -> (
142
    let loc = decl.top_decl_loc in
143
    let basename = Options_management.name_dependency (local, dep) in
144
    let extension = ".lusic" in 
145
    try
146
      let lusic = Lusic.read_lusic basename extension in
147
      Lusic.check_obsolete lusic basename;
148
      lusic
149
    with
150
    | Sys_error msg ->
151
       raise (Error (loc, Error.Unknown_library basename))
151 152
  )
153
  | _ -> assert false (* should not happen *)
154

  
152 155

  
156
let get_envs_from_const const_decl (ty_env, ck_env) =
157
  (Env.add_value ty_env const_decl.const_id const_decl.const_type,
158
   Env.add_value ck_env const_decl.const_id (Clocks.new_var true))
153 159

  
154
let rec load_rec ~is_header imported program =
155
  List.fold_left (fun imported decl ->
156
    match decl.top_decl_desc with
157
    | Node nd -> if is_header then
158
                   raise (Error(decl.top_decl_loc,
159
                                LoadError ("node " ^ nd.node_id ^ " declared in a header file")))  
160
                 else
161
                   (add_node nd.node_id decl; imported)
162
    | ImportedNode ind ->
163
       if is_header then
164
         (add_imported_node ind.nodei_id decl; imported)
165
       else
166
         raise (Error(decl.top_decl_loc,
167
                      LoadError ("imported node " ^ ind.nodei_id ^ " declared in a regular Lustre file")))  
168
    | Const c -> (add_const is_header c.const_id decl; imported)
169
    | TypeDef tdef -> (add_type is_header tdef.tydef_id decl; imported)
170
    | Open (local, dep) ->
171
       let basename = Options_management.name_dependency (local, dep) in
172
       if ISet.mem basename imported then imported else
173
	 let lusic = import_dependency_aux decl.top_decl_loc (local, dep)
174
	 in load_rec ~is_header:true (ISet.add basename imported) lusic.Lusic.contents
175
  ) imported program
160
let get_envs_from_consts const_decls (ty_env, ck_env) =
161
  List.fold_right get_envs_from_const const_decls (ty_env, ck_env)
162

  
163
let rec get_envs_from_top_decl (ty_env, ck_env) top_decl =
164
  match top_decl.top_decl_desc with
165
  | Node nd          -> (Env.add_value ty_env nd.node_id nd.node_type,
166
			 Env.add_value ck_env nd.node_id nd.node_clock)
167
  | ImportedNode ind -> (Env.add_value ty_env ind.nodei_id ind.nodei_type,
168
			 Env.add_value ck_env ind.nodei_id ind.nodei_clock)
169
  | Const c          -> get_envs_from_const c (ty_env, ck_env)
170
  | TypeDef _        -> List.fold_left get_envs_from_top_decl (ty_env, ck_env) (consts_of_enum_type top_decl)
171
  | Open _           -> (ty_env, ck_env)
172

  
173
(* get type and clock environments from a header *)
174
let get_envs_from_top_decls header =
175
  List.fold_left get_envs_from_top_decl (Env.initial, Env.initial) header
176

  
177
  let is_stateful topdecl =
178
  match topdecl.top_decl_desc with
179
  | Node nd -> (match nd.node_stateless with Some b -> not b | None -> not nd.node_dec_stateless)
180
  | ImportedNode nd -> not nd.nodei_stateless 
181
  | _ -> false
182

  
183
let rec load_rec ~is_header accu program =
184
  List.fold_left (fun ((accu_prog, accu_dep, typ_env, clk_env) as accu) decl ->
185
      (* Precompute the updated envs, will not be used in the Open case *)
186
      let typ_env', clk_env' = get_envs_from_top_decl (typ_env, clk_env) decl in
187
      match decl.top_decl_desc with
188
      | Open (local, dep) ->
189
         (* loading the dep *)
190
         let basename = Options_management.name_dependency (local, dep) in
191
         if List.exists
192
              (fun dep -> basename = Options_management.name_dependency (dep.local, dep.name))
193
              accu_dep
194
         then
195
           (* Library already imported. Just skip *)
196
           accu
197
         else (
198
           Log.report ~level:1 (fun fmt -> Format.fprintf fmt "@ Library %s@ " basename);
199
           let lusic = get_lusic decl in
200
           (* Recursive call with accumulator on lusic *)
201
           let (accu_prog, accu_dep, typ_env, clk_env) =
202
             load_rec ~is_header:true accu lusic.Lusic.contents in
203
           (* Building the dep *)
204
           let is_stateful = List.exists is_stateful lusic.Lusic.contents in
205
           let new_dep = { local = local;
206
                           name = dep;
207
                           content = lusic.Lusic.contents;
208
                           is_stateful = is_stateful } in
209
           
210
           (* Returning the prog without the Open, the deps with the new
211
            one and the updated envs *)
212
           accu_prog, (new_dep::accu_dep), typ_env, clk_env
213
         )
214
      (*    | Include xxx -> TODO
215
                     load the lus file
216
                     call load_rec ~is_header:false accu on the luscontent
217
       *)                     
218

  
219
      | Node nd ->
220
         if is_header then
221
           raise (Error(decl.top_decl_loc,
222
                        LoadError ("node " ^ nd.node_id ^ " declared in a header file")))  
223
         else (
224
           (* Registering node *)
225
           add_node nd.node_id decl;
226
           (* Updating the type/clock env *)
227
           decl::accu_prog, accu_dep, typ_env', clk_env'                   
228
         )
229
        
230
      | ImportedNode ind ->
231
         if is_header then (
232
           add_imported_node ind.nodei_id decl;
233
           decl::accu_prog, accu_dep, typ_env', clk_env'                   
234
         )
235
         else
236
           raise (Error(decl.top_decl_loc,
237
                        LoadError ("imported node " ^ ind.nodei_id ^
238
                                     " declared in a regular Lustre file")))  
239
      | Const c -> (
240
        add_const is_header c.const_id decl;
241
        decl::accu_prog, accu_dep, typ_env', clk_env' 
242
      )
243
      | TypeDef tdef -> (
244
        add_type is_header tdef.tydef_id decl;
245
        decl::accu_prog, accu_dep, typ_env', clk_env'
246
      )
247
    ) accu program
176 248

  
177 249
(* Iterates through lusi definitions and records them in the hashtbl. Open instructions are evaluated and update these hashtbl as well. node_table/type/table/consts_table *)
250
let load ~is_header program =
178 251
  
179
let load ~is_header imported program =
180 252
  try
181
    load_rec ~is_header imported program
253
    let prog, deps, typ_env, clk_env =  
254
      load_rec ~is_header
255
        ([], (* accumulator for program elements *)
256
         [], (* accumulator for dependencies *)
257
         Env.initial, (* empty type env *)
258
         Env.initial  (* empty clock env *)
259
        ) program
260
    in
261
    List.rev prog, List.rev deps, (typ_env, clk_env)
182 262
  with
183 263
    Corelang.Error (loc, err) as exc -> (
184
      Format.eprintf "Import error: %a%a@."
185
	Error.pp_error_msg err
186
	Location.pp_loc loc;
187
      raise exc
188
    );;
264
    Format.eprintf "Import error: %a%a@."
265
      Error.pp_error_msg err
266
      Location.pp_loc loc;
267
    raise exc
268
  );;
src/modules.mli
1
open Lustre_types
2
open Utils
3

  
4
(* This module is used to load lusic files when open(ing) modules in
5
   lustre/lusi sources *)
6

  
7
(* Load the provided program, either an actual program or a header lusi files:
8
   - reject program that define imported node
9
   - reject header that define lustre node
10
   - inject #include lus file into the program
11
   - loads #open lusic files
12
     - record the node name and check that they are uniquely defined
13
     - build the type/clock env from the imported nodes
14

  
15
   Returns an extended prog along with dependencies of #open and a type/clock base env. 
16
 *)
17
val load: is_header:bool -> program_t -> program_t * dep_t list * ( Typing.type_expr Env.t * Clocks.clock_expr Env.t)
18

  
19
(* Returns an updated env with the type/clock declaration of the program  *)
20
val get_envs_from_top_decls: program_t -> Typing.type_expr Env.t * Clocks.clock_expr Env.t
21
 

Also available in: Unified diff