diff --git a/src/backends/C/c_backend_common.ml b/src/backends/C/c_backend_common.ml
index 11e823e1588c66184edcbb5f492b1ba5af8c9b9c..f648d3885f54f14aebe54279a3537254a993207c 100644
--- a/src/backends/C/c_backend_common.ml
+++ b/src/backends/C/c_backend_common.ml
@@ -470,26 +470,26 @@ let print_stateless_C_prototype fmt (name, inputs, outputs) =
name
(Utils.fprintf_list ~sep:",@ " pp_c_decl_input_var) inputs
-let print_import_init fmt (Dep (local, basename, _, _)) =
- if local then
- let baseNAME = file_to_module_name basename in
+let print_import_init fmt dep =
+ if dep.local then
+ let baseNAME = file_to_module_name dep.name in
fprintf fmt "%a();" pp_global_init_name baseNAME
else ()
-let print_import_clear fmt (Dep (local, basename, _, _)) =
- if local then
- let baseNAME = file_to_module_name basename in
+let print_import_clear fmt dep =
+ if dep.local then
+ let baseNAME = file_to_module_name dep.name in
fprintf fmt "%a();" pp_global_clear_name baseNAME
else ()
-let print_import_prototype fmt (Dep (_, s, _, _)) =
- fprintf fmt "#include \"%s.h\"@," s
+let print_import_prototype fmt dep =
+ fprintf fmt "#include \"%s.h\"@," dep.name
-let print_import_alloc_prototype fmt (Dep (_, s, _, stateful)) =
- if stateful then
- fprintf fmt "#include \"%s_alloc.h\"@," s
+let print_import_alloc_prototype fmt dep =
+ if dep.is_stateful then
+ fprintf fmt "#include \"%s_alloc.h\"@," dep.name
-let print_extern_alloc_prototypes fmt (Dep (_,_, header,_)) =
+let print_extern_alloc_prototypes fmt dep =
List.iter (fun decl -> match decl.top_decl_desc with
| ImportedNode ind when not ind.nodei_stateless ->
let static = List.filter (fun v -> v.var_dec_const) ind.nodei_inputs in
@@ -498,7 +498,7 @@ let print_extern_alloc_prototypes fmt (Dep (_,_, header,_)) =
fprintf fmt "extern %a;@.@." print_dealloc_prototype ind.nodei_id;
end
| _ -> ()
- ) header
+ ) dep.content
let pp_c_main_var_input fmt id =
diff --git a/src/backends/C/c_backend_header.ml b/src/backends/C/c_backend_header.ml
index 7a23dc8226c8ad5c3aee2da94ed35f828a60b7bf..3b985932caa96bc750645d7cfff368483937030d 100644
--- a/src/backends/C/c_backend_header.ml
+++ b/src/backends/C/c_backend_header.ml
@@ -391,7 +391,7 @@ let print_alloc_header header_fmt basename prog machines dependencies =
(* Import the header *)
fprintf header_fmt "/* Import header from %s */@." basename;
fprintf header_fmt "@[<v>";
- print_import_prototype header_fmt (Dep (true, basename, [], true (* assuming it is staful *) ));
+ print_import_prototype header_fmt {local=true; name=basename; content=[]; is_stateful=true} (* assuming it is staful *);
fprintf header_fmt "@]@.";
fprintf header_fmt "/* Import dependencies */@.";
fprintf header_fmt "@[<v>";
@@ -434,7 +434,7 @@ let print_header_from_header header_fmt basename header =
List.iter
(fun dep ->
let (local, s) = dependency_of_top dep in
- print_import_prototype header_fmt (Dep (local, s, [], true (* assuming it is stateful *))))
+ print_import_prototype header_fmt {local=local; name=s; content=[]; is_stateful=true} (* assuming it is stateful *))
dependencies;
fprintf header_fmt "@]@.";
fprintf header_fmt "/* Types definitions */@.";
diff --git a/src/backends/C/c_backend_main.ml b/src/backends/C/c_backend_main.ml
index 90f3862e692349810c6438ffa064c0a05c9421bc..f1365c6291519bb8201678e41e8cd4ef743dcfe2 100644
--- a/src/backends/C/c_backend_main.ml
+++ b/src/backends/C/c_backend_main.ml
@@ -164,7 +164,7 @@ let print_main_header fmt =
let print_main_c main_fmt main_machine basename prog machines _ (*dependencies*) =
print_main_header main_fmt;
fprintf main_fmt "#include <stdlib.h>@.#include <assert.h>@.";
- print_import_alloc_prototype main_fmt (Dep (true, basename, [], true (* assuming it is stateful*) ));
+ print_import_alloc_prototype main_fmt {local=true; name=basename; content=[]; is_stateful=true} (* assuming it is stateful*) ;
pp_print_newline main_fmt ();
(* Print the svn version number and the supported C standard (C90 or C99) *)
diff --git a/src/backends/C/c_backend_makefile.ml b/src/backends/C/c_backend_makefile.ml
index 90f120bd7f6ff8040eed789f5087104def6b1801..fc55185ba584aa7fbcf6395292d01dda0d8307c8 100644
--- a/src/backends/C/c_backend_makefile.ml
+++ b/src/backends/C/c_backend_makefile.ml
@@ -13,9 +13,9 @@ open Format
open Lustre_types
open Corelang
-let pp_dep fmt (Dep(b,id,tops,stateful)) =
+let pp_dep fmt dep =
Format.fprintf fmt "%b, %s, {%a}, %b"
- b id Printers.pp_prog tops stateful
+ dep.local dep.name Printers.pp_prog dep.content dep.is_stateful
let pp_deps fmt deps = Format.fprintf fmt "@[<v 0>%a@ @]" (Utils.fprintf_list ~sep:"@ ," pp_dep) deps
@@ -37,25 +37,25 @@ let header_libs header =
) [] header
-let compiled_dependencies dep =
- List.filter (fun (Dep (_, _, header, _)) -> header_has_code header) dep
+let compiled_dependencies deps =
+ List.filter (fun dep -> header_has_code dep.content) deps
-let lib_dependencies dep =
+let lib_dependencies deps =
List.fold_left
- (fun accu (Dep (_, _, header, _)) -> Utils.list_union (header_libs header) accu) [] dep
+ (fun accu dep -> Utils.list_union (header_libs dep.content) accu) [] deps
-let fprintf_dependencies fmt (dep: dep_t list) =
+let fprintf_dependencies fmt (deps: dep_t list) =
(* Format.eprintf "Deps: %a@." pp_deps dep; *)
- let compiled_dep = compiled_dependencies dep in
+ let compiled_deps = compiled_dependencies deps in
(* Format.eprintf "Compiled Deps: %a@." pp_deps compiled_dep; *)
List.iter (fun s -> Log.report ~level:1 (fun fmt -> fprintf fmt "Adding dependency: %s@." s);
fprintf fmt "\t${GCC} -I${INC} -c %s@." s)
(("${INC}/io_frontend.c"):: (* IO functions when a main function is computed *)
(List.map
- (fun (Dep (local, s, _, _)) ->
- (if local then s else Version.include_path ^ "/" ^ s) ^ ".c")
- compiled_dep))
+ (fun dep ->
+ (if dep.local then dep.name else Version.include_path ^ "/" ^ dep.name) ^ ".c")
+ compiled_deps))
module type MODIFIERS_MKF =
sig (* dep was (bool * ident * top_decl list) *)
@@ -108,7 +108,7 @@ To be solved (later) with
fprintf fmt "\t${GCC} -I${INC} -I. -c %s_main.c@." basename;
fprintf_dependencies fmt dependencies;
fprintf fmt "\t${GCC} -o ${BINNAME} io_frontend.o %a %s.o %s_main.o %a@."
- (Utils.fprintf_list ~sep:" " (fun fmt (Dep (_, s, _, _)) -> Format.fprintf fmt "%s.o" s))
+ (Utils.fprintf_list ~sep:" " (fun fmt dep -> Format.fprintf fmt "%s.o" dep.name))
(compiled_dependencies dependencies)
basename (* library .o *)
basename (* main function . o *)
diff --git a/src/backends/C/c_backend_mauve.ml b/src/backends/C/c_backend_mauve.ml
index 86f9d4f6b1a3edcf15453da29f2d2e4e58651f89..5456f01e53884f106bd150cb385191d2224d78c4 100644
--- a/src/backends/C/c_backend_mauve.ml
+++ b/src/backends/C/c_backend_mauve.ml
@@ -33,7 +33,7 @@ let fsm_name node = node ^ "FSM"
let print_mauve_header fmt mauve_machine basename prog machines _ (*dependencies*) =
fprintf fmt "#include \"mauve/runtime.hpp\"@.";
- print_import_alloc_prototype fmt (Dep (true, basename, [], true (* assuming it is stateful*) ));
+ print_import_alloc_prototype fmt {local=true; name=basename; content=[]; is_stateful=true} (* assuming it is stateful*) ;
pp_print_newline fmt ();
pp_print_newline fmt ()
diff --git a/src/backends/C/c_backend_spec.ml b/src/backends/C/c_backend_spec.ml
index d996c82b0d2fbfd757cb9ab1bbe9c2452ed44d40..814c1b7b282ab46fa61cd7b452df5759b1378b5e 100644
--- a/src/backends/C/c_backend_spec.ml
+++ b/src/backends/C/c_backend_spec.ml
@@ -158,7 +158,7 @@ let makefile_targets fmt basename nodename dependencies =
C_backend_makefile.fprintf_dependencies fmt dependencies;
fprintf fmt "\t${GCC} -Wno-attributes -o %s_main_eacsl io_frontend.o %a %s %s_main_eacsl.o %a@."
basename
- (Utils.fprintf_list ~sep:" " (fun fmt (Dep (_, s, _, _)) -> Format.fprintf fmt "%s.o" s))
+ (Utils.fprintf_list ~sep:" " (fun fmt dep -> Format.fprintf fmt "%s.o" dep.name))
(C_backend_makefile.compiled_dependencies dependencies)
("${FRAMACEACSL}/e_acsl.c "
^ "${FRAMACEACSL}/memory_model/e_acsl_bittree.c "
diff --git a/src/backends/C/c_backend_src.ml b/src/backends/C/c_backend_src.ml
index 4a00050c9b9eb2bbe4c4797dcd1238e2113b6dda..57316159eeeb3c203d2bed3c1e528c81a5dee782 100644
--- a/src/backends/C/c_backend_src.ml
+++ b/src/backends/C/c_backend_src.ml
@@ -271,26 +271,27 @@ let has_c_prototype funname dependencies =
let imported_node_opt = (* We select the last imported node with the name funname.
The order of evaluation of dependencies should be
compatible with overloading. (Not checked yet) *)
- List.fold_left
- (fun res (Dep (_, _, decls, _)) ->
- match res with
- | Some _ -> res
- | None ->
- let matched = fun t -> match t.top_decl_desc with
- | ImportedNode nd -> nd.nodei_id = funname
- | _ -> false
- in
- if List.exists matched decls then (
- match (List.find matched decls).top_decl_desc with
- | ImportedNode nd -> Some nd
- | _ -> assert false
- )
- else
- None
- ) None dependencies in
- match imported_node_opt with
- | None -> false
- | Some nd -> (match nd.nodei_prototype with Some "C" -> true | _ -> false)
+ List.fold_left
+ (fun res dep ->
+ match res with
+ | Some _ -> res
+ | None ->
+ let decls = dep.content in
+ let matched = fun t -> match t.top_decl_desc with
+ | ImportedNode nd -> nd.nodei_id = funname
+ | _ -> false
+ in
+ if List.exists matched decls then (
+ match (List.find matched decls).top_decl_desc with
+ | ImportedNode nd -> Some nd
+ | _ -> assert false
+ )
+ else
+ None
+ ) None dependencies in
+ match imported_node_opt with
+ | None -> false
+ | Some nd -> (match nd.nodei_prototype with Some "C" -> true | _ -> false)
(*
let pp_instance_call dependencies m self fmt i (inputs: value_t list) (outputs: var_decl list) =
try (* stateful node instance *)
@@ -687,7 +688,7 @@ let print_import_standard source_fmt =
let print_lib_c source_fmt basename prog machines dependencies =
print_import_standard source_fmt;
- print_import_prototype source_fmt (Dep (true, basename, [], true (* assuming it is stateful *)));
+ print_import_prototype source_fmt {local=true; name=basename; content=[]; is_stateful=true} (* assuming it is stateful *);
pp_print_newline source_fmt ();
(* Print the svn version number and the supported C standard (C90 or C99) *)
print_version source_fmt;
diff --git a/src/checks/algebraicLoop.ml b/src/checks/algebraicLoop.ml
index 6c182e4c9d69f97d4fd76b9dba5427a7c9d37e9f..91dcb34a4337fa8d5691eacde4e171256063ef5a 100644
--- a/src/checks/algebraicLoop.ml
+++ b/src/checks/algebraicLoop.ml
@@ -144,7 +144,7 @@ let fast_stages_processing prog =
(* Mini stage 1 *)
(* Extracting dependencies: fill some table with typing info *)
- ignore (Compiler_common.import_dependencies prog);
+ ignore (Modules.load ~is_header:false prog);
(* Local inlining *)
let prog = Inliner.local_inline prog (* type_env clock_env *) in
(* Checking stateless/stateful status *)
diff --git a/src/compiler_common.ml b/src/compiler_common.ml
index 14b3ffb2e074e0ef8682b1ce93c3855c2eb5090d..f197f1f5a6509f197ea77db11094862bd8a5a440 100644
--- a/src/compiler_common.ml
+++ b/src/compiler_common.ml
@@ -153,26 +153,6 @@ let check_top_decls header =
let new_cenv = clock_decls Basic_library.clock_env header in (* Clock calculus *)
header, new_tenv, new_cenv
-let get_envs_from_const const_decl (ty_env, ck_env) =
- (Env.add_value ty_env const_decl.const_id const_decl.const_type,
- Env.add_value ck_env const_decl.const_id (Clocks.new_var true))
-
-let get_envs_from_consts const_decls (ty_env, ck_env) =
- List.fold_right get_envs_from_const const_decls (ty_env, ck_env)
-
-let rec get_envs_from_top_decl (ty_env, ck_env) top_decl =
- match top_decl.top_decl_desc with
- | Node nd -> (Env.add_value ty_env nd.node_id nd.node_type,
- Env.add_value ck_env nd.node_id nd.node_clock)
- | ImportedNode ind -> (Env.add_value ty_env ind.nodei_id ind.nodei_type,
- Env.add_value ck_env ind.nodei_id ind.nodei_clock)
- | Const c -> get_envs_from_const c (ty_env, ck_env)
- | TypeDef _ -> List.fold_left get_envs_from_top_decl (ty_env, ck_env) (consts_of_enum_type top_decl)
- | Open _ -> (ty_env, ck_env)
-
-(* get type and clock environments from a header *)
-let get_envs_from_top_decls header =
- List.fold_left get_envs_from_top_decl (Env.initial, Env.initial) header
(*
List.fold_right
@@ -226,39 +206,6 @@ let check_compatibility (prog, computed_types_env, computed_clocks_env) (header,
Location.pp_loc loc;
raise exc
-let is_stateful topdecl =
- match topdecl.top_decl_desc with
- | Node nd -> (match nd.node_stateless with Some b -> not b | None -> not nd.node_dec_stateless)
- | ImportedNode nd -> not nd.nodei_stateless
- | _ -> false
-
-(* Beware of the side effect: reads and modifies Global.(type_env/clock_env) *)
-let rec import_dependencies prog : dep_t list =
- Log.report ~level:1 (fun fmt -> fprintf fmt "@[<v 4>.. extracting dependencies");
- let dependencies = Corelang.get_dependencies prog in
- let (compilation_deps, type_env, clock_env) =
- List.fold_left
- (fun (compilation_dep, type_env, clock_env) dep ->
- let (local, s) = Corelang.dependency_of_top dep in
- let basename = Options_management.name_dependency (local, s) in
- Log.report ~level:1 (fun fmt -> Format.fprintf fmt "@ Library %s@ " basename);
- let lusic = Modules.import_dependency dep.top_decl_loc (local, s) in
- (*Log.report ~level:1 (fun fmt -> Format.fprintf fmt "");*)
- let lusic_deps = import_dependencies lusic.Lusic.contents in
- let (lusi_type_env, lusi_clock_env) = get_envs_from_top_decls lusic.Lusic.contents in
- let is_stateful = List.exists is_stateful lusic.Lusic.contents in
- let new_dep = Dep (local, s, lusic.Lusic.contents, is_stateful ) in
- new_dep::lusic_deps@compilation_dep,
- Env.overwrite type_env lusi_type_env,
- Env.overwrite clock_env lusi_clock_env)
- ([], !Global.type_env, !Global.clock_env)
- dependencies in
- Global.type_env := type_env;
- Global.clock_env := clock_env;
- begin
- Log.report ~level:1 (fun fmt -> fprintf fmt "@]@ ");
- compilation_deps
- end
let track_exception () =
if !Options.track_exceptions
diff --git a/src/compiler_stages.ml b/src/compiler_stages.ml
index 6e77864a85f506d8a16a4916009c28a48d7f9feb..18c7fc025efbec4c6fa032837c56d724909b2ec1 100644
--- a/src/compiler_stages.ml
+++ b/src/compiler_stages.ml
@@ -36,9 +36,9 @@ let compile_source_to_header prog computed_types_env computed_clocks_env dirname
else
begin
Log.report ~level:1 (fun fmt -> fprintf fmt ".. loading compiled header file %s@," header_name);
- Modules.check_dependency lusic destname;
+ Lusic.check_obsolete lusic destname;
let header = lusic.Lusic.contents in
- let (declared_types_env, declared_clocks_env) = get_envs_from_top_decls header in
+ let (declared_types_env, declared_clocks_env) = Modules.get_envs_from_top_decls header in
check_compatibility
(prog, computed_types_env, computed_clocks_env)
(header, declared_types_env, declared_clocks_env)
@@ -56,10 +56,14 @@ let stage1 params prog dirname basename =
Log.report ~level:4 (fun fmt -> fprintf fmt ".. after automata expansion:@, @[<v 2>@,%a@]@ " Printers.pp_prog prog);
(* Importing source *)
- let _ = Modules.load ~is_header:false ISet.empty prog in
+ let prog, dependencies, (typ_env, clk_env) = Modules.load ~is_header:false prog in
- (* Extracting dependencies (and updating Global.(type_env/clock_env) *)
- let dependencies = import_dependencies prog in
+ (* Registering types and clocks for future checks *)
+ Global.type_env := Env.overwrite !Global.type_env typ_env;
+ Global.clock_env := Env.overwrite !Global.clock_env clk_env;
+
+ (* (\* Extracting dependencies (and updating Global.(type_env/clock_env) *\)
+ * let dependencies = import_dependencies prog in *)
(* Sorting nodes *)
let prog = SortProg.sort prog in
diff --git a/src/lustre_types.ml b/src/lustre_types.ml
index 93d5dc299dea4e3618780567050ec566f2e5df47..bbd0292abe818f7ee9d9a990ffb76a6c44f46a8c 100644
--- a/src/lustre_types.ml
+++ b/src/lustre_types.ml
@@ -228,12 +228,12 @@ type top_decl =
type program_t = top_decl list
-type dep_t = Dep of
- bool
- * ident
- * (top_decl list)
- * bool (* is stateful *)
-
+type dep_t = {
+ local: bool;
+ name: ident;
+ content: program_t;
+ is_stateful: bool
+ }
diff --git a/src/main_lustre_compiler.ml b/src/main_lustre_compiler.ml
index b3299561a121be2518a0760b490156a879eea498..6d6a589b8565b8d838100958988948536ab1e6e3 100644
--- a/src/main_lustre_compiler.ml
+++ b/src/main_lustre_compiler.ml
@@ -42,13 +42,17 @@ let compile_header dirname basename extension =
begin
Log.report ~level:1 (fun fmt -> fprintf fmt "@[<v>");
let header = parse_header true (dirname ^ "/" ^ header_name) in
- ignore (Modules.load ~is_header:true ISet.empty header);
+ (* Disbaled today, should be done anyway when following the regular compilation
+ignore (Modules.load ~is_header:true ISet.empty header); *)
ignore (check_top_decls header); (* typing/clocking with an empty env *)
create_dest_dir ();
Log.report ~level:1
(fun fmt -> fprintf fmt ".. generating compiled header file %sc@," (destname ^ extension));
Lusic.write_lusic true header destname lusic_ext;
generate_lusic_header destname lusic_ext;
+
+
+
Log.report ~level:1 (fun fmt -> fprintf fmt ".. done !@ @]@ ")
end
diff --git a/src/main_lustre_testgen.ml b/src/main_lustre_testgen.ml
index d27ce216b8bb81ffd959ba07bed6302d29c3b8e8..a40d1013ba950b39811a85f1e3b550d9441e63e6 100644
--- a/src/main_lustre_testgen.ml
+++ b/src/main_lustre_testgen.ml
@@ -56,7 +56,7 @@ let testgen_source dirname basename extension =
if !Options.gen_mcdc then (
let prog_mcdc = PathConditions.mcdc prog in
(* We re-type the fresh equations *)
- let _ = import_dependencies prog_mcdc in
+ let _ = Modules.load ~is_header:false prog_mcdc in
let _ = type_decls !Global.type_env prog_mcdc in
let destname = !Options.dest_dir ^ "/" ^ basename in
diff --git a/src/modules.ml b/src/modules.ml
index 53d9ef491ae6108f73610052a3027fb89bed6865..a97179d42ea281194f4865170db56247031dbe84 100644
--- a/src/modules.ml
+++ b/src/modules.ml
@@ -23,6 +23,7 @@ let check_symbol loc msg hashtbl name =
then raise (Error (loc, Error.Unbound_symbol msg))
else ()
+
let add_imported_node name value =
(*Format.eprintf "add_imported_node %s %a (owner=%s)@." name Printers.pp_imported_node (imported_node_of_top value) value.top_decl_owner;*)
try
@@ -122,12 +123,8 @@ let import_dependency_aux loc (local, dep) =
lusic
with
| Sys_error msg ->
- begin
- (*Format.eprintf "Error: %s@." msg;*)
raise (Error (loc, Error.Unknown_library basename))
- end
- | Corelang.Error (_, msg) -> raise (Corelang.Error (loc, msg))
-
+
let import_dependency loc (local, dep) =
try
import_dependency_aux loc (local, dep)
@@ -139,50 +136,133 @@ let import_dependency loc (local, dep) =
raise exc
)
-let check_dependency lusic basename =
- try
- Lusic.check_obsolete lusic basename
- with
- | Corelang.Error (loc, err) as exc -> (
- Format.eprintf "Import error: %a%a@."
- Error.pp_error_msg err
- Location.pp_loc loc;
- raise exc
+let get_lusic decl =
+ match decl.top_decl_desc with
+ | Open (local, dep) -> (
+ let loc = decl.top_decl_loc in
+ let basename = Options_management.name_dependency (local, dep) in
+ let extension = ".lusic" in
+ try
+ let lusic = Lusic.read_lusic basename extension in
+ Lusic.check_obsolete lusic basename;
+ lusic
+ with
+ | Sys_error msg ->
+ raise (Error (loc, Error.Unknown_library basename))
)
+ | _ -> assert false (* should not happen *)
+
+let get_envs_from_const const_decl (ty_env, ck_env) =
+ (Env.add_value ty_env const_decl.const_id const_decl.const_type,
+ Env.add_value ck_env const_decl.const_id (Clocks.new_var true))
-let rec load_rec ~is_header imported program =
- List.fold_left (fun imported decl ->
- match decl.top_decl_desc with
- | Node nd -> if is_header then
- raise (Error(decl.top_decl_loc,
- LoadError ("node " ^ nd.node_id ^ " declared in a header file")))
- else
- (add_node nd.node_id decl; imported)
- | ImportedNode ind ->
- if is_header then
- (add_imported_node ind.nodei_id decl; imported)
- else
- raise (Error(decl.top_decl_loc,
- LoadError ("imported node " ^ ind.nodei_id ^ " declared in a regular Lustre file")))
- | Const c -> (add_const is_header c.const_id decl; imported)
- | TypeDef tdef -> (add_type is_header tdef.tydef_id decl; imported)
- | Open (local, dep) ->
- let basename = Options_management.name_dependency (local, dep) in
- if ISet.mem basename imported then imported else
- let lusic = import_dependency_aux decl.top_decl_loc (local, dep)
- in load_rec ~is_header:true (ISet.add basename imported) lusic.Lusic.contents
- ) imported program
+let get_envs_from_consts const_decls (ty_env, ck_env) =
+ List.fold_right get_envs_from_const const_decls (ty_env, ck_env)
+
+let rec get_envs_from_top_decl (ty_env, ck_env) top_decl =
+ match top_decl.top_decl_desc with
+ | Node nd -> (Env.add_value ty_env nd.node_id nd.node_type,
+ Env.add_value ck_env nd.node_id nd.node_clock)
+ | ImportedNode ind -> (Env.add_value ty_env ind.nodei_id ind.nodei_type,
+ Env.add_value ck_env ind.nodei_id ind.nodei_clock)
+ | Const c -> get_envs_from_const c (ty_env, ck_env)
+ | TypeDef _ -> List.fold_left get_envs_from_top_decl (ty_env, ck_env) (consts_of_enum_type top_decl)
+ | Open _ -> (ty_env, ck_env)
+
+(* get type and clock environments from a header *)
+let get_envs_from_top_decls header =
+ List.fold_left get_envs_from_top_decl (Env.initial, Env.initial) header
+
+ let is_stateful topdecl =
+ match topdecl.top_decl_desc with
+ | Node nd -> (match nd.node_stateless with Some b -> not b | None -> not nd.node_dec_stateless)
+ | ImportedNode nd -> not nd.nodei_stateless
+ | _ -> false
+
+let rec load_rec ~is_header accu program =
+ List.fold_left (fun ((accu_prog, accu_dep, typ_env, clk_env) as accu) decl ->
+ (* Precompute the updated envs, will not be used in the Open case *)
+ let typ_env', clk_env' = get_envs_from_top_decl (typ_env, clk_env) decl in
+ match decl.top_decl_desc with
+ | Open (local, dep) ->
+ (* loading the dep *)
+ let basename = Options_management.name_dependency (local, dep) in
+ if List.exists
+ (fun dep -> basename = Options_management.name_dependency (dep.local, dep.name))
+ accu_dep
+ then
+ (* Library already imported. Just skip *)
+ accu
+ else (
+ Log.report ~level:1 (fun fmt -> Format.fprintf fmt "@ Library %s@ " basename);
+ let lusic = get_lusic decl in
+ (* Recursive call with accumulator on lusic *)
+ let (accu_prog, accu_dep, typ_env, clk_env) =
+ load_rec ~is_header:true accu lusic.Lusic.contents in
+ (* Building the dep *)
+ let is_stateful = List.exists is_stateful lusic.Lusic.contents in
+ let new_dep = { local = local;
+ name = dep;
+ content = lusic.Lusic.contents;
+ is_stateful = is_stateful } in
+
+ (* Returning the prog without the Open, the deps with the new
+ one and the updated envs *)
+ accu_prog, (new_dep::accu_dep), typ_env, clk_env
+ )
+ (* | Include xxx -> TODO
+ load the lus file
+ call load_rec ~is_header:false accu on the luscontent
+ *)
+
+ | Node nd ->
+ if is_header then
+ raise (Error(decl.top_decl_loc,
+ LoadError ("node " ^ nd.node_id ^ " declared in a header file")))
+ else (
+ (* Registering node *)
+ add_node nd.node_id decl;
+ (* Updating the type/clock env *)
+ decl::accu_prog, accu_dep, typ_env', clk_env'
+ )
+
+ | ImportedNode ind ->
+ if is_header then (
+ add_imported_node ind.nodei_id decl;
+ decl::accu_prog, accu_dep, typ_env', clk_env'
+ )
+ else
+ raise (Error(decl.top_decl_loc,
+ LoadError ("imported node " ^ ind.nodei_id ^
+ " declared in a regular Lustre file")))
+ | Const c -> (
+ add_const is_header c.const_id decl;
+ decl::accu_prog, accu_dep, typ_env', clk_env'
+ )
+ | TypeDef tdef -> (
+ add_type is_header tdef.tydef_id decl;
+ decl::accu_prog, accu_dep, typ_env', clk_env'
+ )
+ ) accu program
(* 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 *)
+let load ~is_header program =
-let load ~is_header imported program =
try
- load_rec ~is_header imported program
+ let prog, deps, typ_env, clk_env =
+ load_rec ~is_header
+ ([], (* accumulator for program elements *)
+ [], (* accumulator for dependencies *)
+ Env.initial, (* empty type env *)
+ Env.initial (* empty clock env *)
+ ) program
+ in
+ List.rev prog, List.rev deps, (typ_env, clk_env)
with
Corelang.Error (loc, err) as exc -> (
- Format.eprintf "Import error: %a%a@."
- Error.pp_error_msg err
- Location.pp_loc loc;
- raise exc
- );;
+ Format.eprintf "Import error: %a%a@."
+ Error.pp_error_msg err
+ Location.pp_loc loc;
+ raise exc
+ );;
diff --git a/src/modules.mli b/src/modules.mli
new file mode 100644
index 0000000000000000000000000000000000000000..e9e5aaa54ca2861ca3bca2c3962d450b5c2a1068
--- /dev/null
+++ b/src/modules.mli
@@ -0,0 +1,21 @@
+open Lustre_types
+open Utils
+
+(* This module is used to load lusic files when open(ing) modules in
+ lustre/lusi sources *)
+
+(* Load the provided program, either an actual program or a header lusi files:
+ - reject program that define imported node
+ - reject header that define lustre node
+ - inject #include lus file into the program
+ - loads #open lusic files
+ - record the node name and check that they are uniquely defined
+ - build the type/clock env from the imported nodes
+
+ Returns an extended prog along with dependencies of #open and a type/clock base env.
+ *)
+val load: is_header:bool -> program_t -> program_t * dep_t list * ( Typing.type_expr Env.t * Clocks.clock_expr Env.t)
+
+(* Returns an updated env with the type/clock declaration of the program *)
+val get_envs_from_top_decls: program_t -> Typing.type_expr Env.t * Clocks.clock_expr Env.t
+