diff --git a/compiler/heptagon/analysis/typing.ml b/compiler/heptagon/analysis/typing.ml index 3b0cff7..2416e37 100644 --- a/compiler/heptagon/analysis/typing.ml +++ b/compiler/heptagon/analysis/typing.ml @@ -561,8 +561,8 @@ let rec typing const_env h e = List.map (fun { p_name = n } -> local_qn n) ty_desc.node_params in let m = build_subst node_params params in let expected_ty_list = - List.map (subst_type_vars m) expected_ty_list in - let result_ty_list = List.map (subst_type_vars m) result_ty_list in + List.map (simplify m) expected_ty_list in + let result_ty_list = List.map (simplify m) result_ty_list in let typed_n = expect_static_exp const_env (Tid Initial.pint) n in let ty, typed_e_list = typing_iterator const_env h it n expected_ty_list result_ty_list e_list in diff --git a/compiler/heptagon/main/hept_compiler.ml b/compiler/heptagon/main/hept_compiler.ml index 4a44587..b90dd36 100644 --- a/compiler/heptagon/main/hept_compiler.ml +++ b/compiler/heptagon/main/hept_compiler.ml @@ -11,6 +11,7 @@ open Misc open Compiler_utils open Location +open Global_printer let pp p = if !verbose then Hept_printer.print stdout p @@ -39,7 +40,7 @@ let compile_impl pp p = (*let p = pass "Typing" true Typing.program p pp in*) let p = silent_pass "Statefullness check" true Statefull.program p in - if !print_types then print_interface Format.std_formatter l; + if !print_types then print_interface Format.std_formatter p; (* Causality check *) let p = silent_pass "Causality check" true Causality.program p in @@ -95,7 +96,7 @@ let compile_interface modname filename = if !print_types then print_interface Format.std_formatter l; - Modules.write itc; + output_value itc (Modules.current_module ()); close_all_files () with diff --git a/compiler/heptagon/parsing/hept_scoping.ml b/compiler/heptagon/parsing/hept_scoping.ml index 713e0de..77a38b6 100644 --- a/compiler/heptagon/parsing/hept_scoping.ml +++ b/compiler/heptagon/parsing/hept_scoping.ml @@ -379,7 +379,7 @@ let params_of_var_decs local_const = let args_of_var_decs local_const = List.map (fun vd -> Signature.mk_arg - (Some (name vd.v_name)) + (Some vd.v_name) (translate_type vd.v_loc local_const vd.v_type)) let translate_node node = diff --git a/compiler/main/hept2mls.ml b/compiler/main/hept2mls.ml index 792a9ad..7d30be9 100644 --- a/compiler/main/hept2mls.ml +++ b/compiler/main/hept2mls.ml @@ -48,7 +48,7 @@ struct type env = | Eempty | Ecomp of env * IdentSet.t - | Eon of env * longname * ident + | Eon of env * constructor_name * ident let empty = Eempty diff --git a/compiler/main/heptc.ml b/compiler/main/heptc.ml index 200cf68..a8d1aba 100644 --- a/compiler/main/heptc.ml +++ b/compiler/main/heptc.ml @@ -44,7 +44,7 @@ let compile_impl modname filename = (* Process the Heptagon AST *) let p = compile_impl pp p in - Modules.write_current_module itc; + output_value itc (Modules.current_module ()); (* Set pretty printer to the Minils one *) let pp = Mls_compiler.pp in diff --git a/compiler/minils/transformations/callgraph.ml b/compiler/minils/transformations/callgraph.ml index f39755b..31c0bd8 100644 --- a/compiler/minils/transformations/callgraph.ml +++ b/compiler/minils/transformations/callgraph.ml @@ -8,6 +8,7 @@ open Static open Global_mapfold open Mls_mapfold open Minils +open Global_printer module Error = struct @@ -32,7 +33,7 @@ end module Param_instances : sig type key = private static_exp (** Fully instantiated param *) - type env = key NamesEnv.t + type env = key QualEnv.t val instantiate: env -> static_exp list -> key list val get_node_instances : QualEnv.key -> key list list val add_node_instance : QualEnv.key -> key list -> unit @@ -44,7 +45,7 @@ sig end = struct type key = static_exp - type env = key NamesEnv.t + type env = key QualEnv.t (** An instance is a list of instantiated params *) type instance = key list @@ -121,7 +122,7 @@ struct (** Build an environment by instantiating the passed params *) let build env params_names params_values = - List.fold_left2 (fun m { p_name = n } v -> NamesEnv.add n v m) + List.fold_left2 (fun m { p_name = n } v -> QualEnv.add (local_qn n) v m) env params_names (instantiate env params_values) @@ -133,10 +134,10 @@ struct let static_exp funs m se = let se, _ = Global_mapfold.static_exp funs m se in let se = match se.se_desc with - | Svar { qual = q; name = n } -> - if q = local_qualname + | Svar q -> + if q.qual = local_qualname then (* This var is a static parameter, it has to be instanciated *) - (try NamesEnv.find n m + (try QualEnv.find q m with Not_found -> Format.eprintf "local param not local"; assert false;) @@ -171,17 +172,17 @@ struct let funs = { Mls_mapfold.defaults with edesc = edesc; global_funs = global_funs } in - let m = build NamesEnv.empty n.n_params params in + let m = build QualEnv.empty n.n_params params in let n, _ = Mls_mapfold.node_dec_it funs m n in (* Add to the global environment the signature of the new instance *) - let { info = node_sig } = find_value n.n_name in + let node_sig = find_value n.n_name in let node_sig, _ = Global_mapfold.node_it global_funs m node_sig in let node_sig = { node_sig with node_params = []; node_params_constraints = [] } in (* Find the name that was associated to this instance *) let ln = node_for_params_call n.n_name params in - Modules.add_value_by_longname ln node_sig; + Modules.add_value ln node_sig; { n with n_name = ln; n_params = []; n_params_constraints = []; } let node_dec modname n = @@ -211,7 +212,7 @@ let load_object_file modname = Modules.open_module modname; let name = String.uncapitalize modname in try - let filename = Modules.findfile (name ^ ".epo") in + let filename = Misc.findfile (name ^ ".epo") in let ic = open_in_bin filename in try let p:program = input_value ic in @@ -230,7 +231,7 @@ let load_object_file modname = Please recompile %s.ept first.@." filename name; raise Error with - | Modules.Cannot_find_file(filename) -> + | Misc.Cannot_find_file(filename) -> Format.eprintf "Cannot find the object file '%s'.@." filename; raise Error @@ -285,7 +286,7 @@ let called_nodes ln = let rec call_node (ln, params) = (* First, add the instance for this node *) let n = node_by_longname ln in - let m = build NamesEnv.empty n.n_params params in + let m = build QualEnv.empty n.n_params params in (* List.iter check_no_static_var params; *) add_node_instance ln params; diff --git a/compiler/minils/transformations/itfusion.ml b/compiler/minils/transformations/itfusion.ml index ba35770..31b6e38 100644 --- a/compiler/minils/transformations/itfusion.ml +++ b/compiler/minils/transformations/itfusion.ml @@ -8,29 +8,29 @@ open Minils (* Functions to temporarily store anonymous nodes*) let mk_fresh_node_name () = - longname (Idents.name (Idents.fresh "_n_")) + current_qual (Idents.name (Idents.fresh "_n_")) -let anon_nodes = ref LongNameEnv.empty +let anon_nodes = ref QualEnv.empty let add_anon_node inputs outputs locals eqs = let n = mk_fresh_node_name () in let nd = mk_node ~input:inputs ~output:outputs ~local:locals - ~eq:eqs (shortname n) in - anon_nodes := LongNameEnv.add n nd !anon_nodes; + ~eq:eqs n in + anon_nodes := QualEnv.add n nd !anon_nodes; n let replace_anon_node n nd = - anon_nodes := LongNameEnv.add n nd !anon_nodes + anon_nodes := QualEnv.add n nd !anon_nodes let find_anon_node n = - LongNameEnv.find n !anon_nodes + QualEnv.find n !anon_nodes let is_anon_node n = - LongNameEnv.mem n !anon_nodes + QualEnv.mem n !anon_nodes let are_equal n m = - let n = simplify NamesEnv.empty n in - let m = simplify NamesEnv.empty m in + let n = simplify QualEnv.empty n in + let m = simplify QualEnv.empty m in n = m let pat_of_vd_list l = @@ -56,7 +56,7 @@ let get_node_inp_outp app = match app.a_op with nd.n_input, nd.n_output | Enode f | Efun f -> (* it is a regular node*) - let { info = ty_desc } = find_value f in + let ty_desc = find_value f in let new_inp = List.map vd_of_arg ty_desc.node_outputs in let new_outp = List.map vd_of_arg ty_desc.node_outputs in new_inp, new_outp diff --git a/compiler/minils/transformations/schedule.ml b/compiler/minils/transformations/schedule.ml index 4088967..4d29093 100644 --- a/compiler/minils/transformations/schedule.ml +++ b/compiler/minils/transformations/schedule.ml @@ -77,6 +77,7 @@ let eqs funs () eq_list = let eqs, () = Mls_mapfold.eqs funs () eq_list in schedule eqs, () +let edesc funs () = function | Eiterator(it, ({ a_op = Enode f } as app), n, e_list, r) when Itfusion.is_anon_node f -> let nd = Itfusion.find_anon_node f in diff --git a/compiler/obc/c/cgen.ml b/compiler/obc/c/cgen.ml index 2c13980..7d9a49e 100644 --- a/compiler/obc/c/cgen.ml +++ b/compiler/obc/c/cgen.ml @@ -154,10 +154,9 @@ let rec assoc_type n var_env = let rec unalias_ctype = function | Cty_id ty_name -> (try - let { qualname = q; info = ty_desc } = find_type (qualname ty_name) in - match ty_desc with - | Talias ty -> unalias_ctype (ctype_of_otype ty) - | _ -> Cty_id ty_name + match find_type (current_qual ty_name) with + | Talias ty -> unalias_ctype (ctype_of_otype ty) + | _ -> Cty_id ty_name with Not_found -> Cty_id ty_name) | Cty_arr (n, cty) -> Cty_arr (n, unalias_ctype cty) | Cty_ptr cty -> Cty_ptr (unalias_ctype cty) @@ -180,8 +179,8 @@ let rec assoc_type_lhs lhs var_env = | Cfield(x, f) -> let ty = assoc_type_lhs x var_env in let n = struct_name ty in - let { info = fields } = find_struct (qualname n) in - ctype_of_otype (field_assoc (qualname f) fields) + let fields = find_struct (current_qual n) in + ctype_of_otype (field_assoc (current_qual f) fields) (** Creates the statement a = [e_1, e_2, ..], which gives a list a[i] = e_i.*) @@ -232,11 +231,11 @@ let rec cexpr_of_static_exp se = Carraylit (repeat_list cc (int_of_static_exp n)) | Svar ln -> (try - let { info = cd } = find_const ln in - cexpr_of_static_exp (Static.simplify NamesEnv.empty cd.c_value) + let cd = find_const ln in + cexpr_of_static_exp (Static.simplify QualEnv.empty cd.c_value) with Not_found -> assert false) | Sop _ -> - let se' = Static.simplify NamesEnv.empty se in + let se' = Static.simplify QualEnv.empty se in if se = se' then Error.message se.se_loc Error.Estatic_exp_compute_failed else @@ -364,7 +363,7 @@ let generate_function_call var_env obj_env outvl objn args = else (** The step function takes scalar arguments and its own internal memory holding structure. *) - let args = step_fun_call var_env sig_info.info objn out args in + let args = step_fun_call var_env sig_info objn out args in (** Our C expression for the function call. *) Cfun_call (classn ^ "_step", args) in diff --git a/compiler/obc/obc_printer.ml b/compiler/obc/obc_printer.ml index fb56ca9..83d5b9f 100644 --- a/compiler/obc/obc_printer.ml +++ b/compiler/obc/obc_printer.ml @@ -4,6 +4,7 @@ open Pp_tools open Types open Idents open Names +open Global_printer let print_vd ff vd = fprintf ff "@[";