diff --git a/.gitignore b/.gitignore index faee133..c7523d0 100644 --- a/.gitignore +++ b/.gitignore @@ -28,3 +28,19 @@ _build test/*.ml test/_check_builds lib/java/.classpath +/test/async/build/convolutions_a.ept +/test/async/build/convolutions.ept +/test/async/build/fork_join_a.ept +/test/async/build/fork_join.ept +/test/async/build/java/.classpath +/test/async/build/kill.ept +/test/async/build/kill_node.ept +/test/async/build/moyen_lent_rapide_a.ept +/test/async/build/moyen_lent_rapide.ept +/test/async/build/rapide_lent_a2.ept +/test/async/build/reset_6_a.ept +/test/async/build/reset_6.ept +/test/async/build/reset_a.ept +/test/async/build/reset.ept +/test/async/build/t.ept +/test/async/build/tt.ept diff --git a/compiler/global/clocks.ml b/compiler/global/clocks.ml index 024d092..cf43a74 100644 --- a/compiler/global/clocks.ml +++ b/compiler/global/clocks.ml @@ -105,7 +105,7 @@ and unify_list t1_list t2_list = let rec skeleton ck = function | Tprod ty_list -> (match ty_list with - | [x] -> Ck ck + | [_] -> Ck ck | l -> Cprod (List.map (skeleton ck) l)) | Tarray _ | Tid _ | Tinvalid -> Ck ck diff --git a/compiler/global/names.ml b/compiler/global/names.ml index 5aac9da..ef7d72a 100644 --- a/compiler/global/names.ml +++ b/compiler/global/names.ml @@ -53,7 +53,7 @@ let modul { qual = m; } = m let rec modul_to_string m = match m with | Pervasives -> "Pervasives" - | LocalModule -> "\#$%@#_LOCAL_MODULE" + | LocalModule -> "#$%@#_LOCAL_MODULE" | Module n -> n | QualModule {qual = q; name = n} -> (modul_to_string q) ^"."^ n diff --git a/compiler/heptagon/analysis/causality.ml b/compiler/heptagon/analysis/causality.ml index cc6bb8b..ffb0395 100644 --- a/compiler/heptagon/analysis/causality.ml +++ b/compiler/heptagon/analysis/causality.ml @@ -108,7 +108,7 @@ let rec typing e = candlist l | Eiterator (_, _, _, pe_list, e_list, _) -> ctuplelist (List.map typing (pe_list@e_list)) - | Ewhen (e, c, x) -> + | Ewhen (e, _, x) -> let t = typing e in let tc = read x in cseq tc t diff --git a/compiler/heptagon/hept_mapfold.ml b/compiler/heptagon/hept_mapfold.ml index 3b27e08..86df74a 100644 --- a/compiler/heptagon/hept_mapfold.ml +++ b/compiler/heptagon/hept_mapfold.ml @@ -285,7 +285,7 @@ and program_desc_it funs acc pd = with Fallback -> program_desc funs acc pd and program_desc funs acc pd = match pd with | Pconst cd -> let cd, acc = const_dec_it funs acc cd in Pconst cd, acc - | Ptype td -> pd, acc + | Ptype td -> pd, acc (* TODO types *) | Pnode n -> let n, acc = node_dec_it funs acc n in Pnode n, acc let defaults = { diff --git a/compiler/heptagon/transformations/inline.ml b/compiler/heptagon/transformations/inline.ml index 4acec7f..487b551 100644 --- a/compiler/heptagon/transformations/inline.ml +++ b/compiler/heptagon/transformations/inline.ml @@ -27,9 +27,9 @@ let mk_unique_node nd = let subst = List.map mk_bind (nd.n_block.b_local @ nd.n_input @ nd.n_output) in - let subst_var_dec funs () vd = + let subst_var_dec _ () vd = ({ vd with v_ident = (List.assoc vd.v_ident subst).v_ident; }, ()) in - let subst_edesc funs () ed = match ed with + let subst_edesc _ () ed = match ed with | Evar vn -> (Evar (List.assoc vn subst).v_ident, ()) | _ -> raise Errors.Fallback in let subst_eqdesc funs () eqd = @@ -100,7 +100,7 @@ let exp funs (env, newvars, newequs) exp = match exp.e_desc with | _ -> Hept_mapfold.exp funs (env, newvars, newequs) exp let block funs (env, newvars, newequs) blk = - let (block, (env, newvars, newequs)) = + let (_, (env, newvars, newequs)) = Hept_mapfold.block funs (env, newvars, newequs) blk in ({ blk with b_local = newvars @ blk.b_local; b_equs = newequs @ blk.b_equs; }, (env, [], [])) diff --git a/compiler/heptagon/transformations/itfusion.ml b/compiler/heptagon/transformations/itfusion.ml index 0caf3aa..57fea0b 100644 --- a/compiler/heptagon/transformations/itfusion.ml +++ b/compiler/heptagon/transformations/itfusion.ml @@ -28,7 +28,7 @@ let anon_nodes = ref QualEnv.empty let add_anon_node inputs outputs locals eqs = let n = mk_fresh_node_name () in let b = mk_block ~locals:locals eqs in - let nd = mk_node ~input:inputs ~output:outputs ~local:locals n b in + let nd = mk_node ~input:inputs ~output:outputs n b in anon_nodes := QualEnv.add n nd !anon_nodes; n diff --git a/compiler/heptagon/transformations/reset.ml b/compiler/heptagon/transformations/reset.ml index 594e478..b5a347d 100644 --- a/compiler/heptagon/transformations/reset.ml +++ b/compiler/heptagon/transformations/reset.ml @@ -52,7 +52,7 @@ let default e = | _ -> None -let edesc funs ((res,stateful) as acc) ed = match ed with +let edesc funs ((res,_) as acc) ed = match ed with | Efby (e1, e2) -> let e1,_ = Hept_mapfold.exp_it funs acc e1 in let e2,_ = Hept_mapfold.exp_it funs acc e2 in @@ -68,20 +68,18 @@ let edesc funs ((res,stateful) as acc) ed = match ed with | Eapp({ a_op = Enode _ } as op, e_list, re) -> let args,_ = mapfold (Hept_mapfold.exp_it funs) acc e_list in let re,_ = optional_wacc (Hept_mapfold.exp_it funs) acc re in - Eapp(op, e_list, merge_resets res re), acc + Eapp(op, args, merge_resets res re), acc | Eiterator(it, ({ a_op = Enode _ } as op), n, pe_list, e_list, re) -> let pargs,_ = mapfold (Hept_mapfold.exp_it funs) acc pe_list in let args,_ = mapfold (Hept_mapfold.exp_it funs) acc e_list in let re,_ = optional_wacc (Hept_mapfold.exp_it funs) acc re in Eiterator(it, op, n, pargs, args, merge_resets res re), acc - | Eapp({ a_op = Efun _ } as op, e_list, re) -> + | Eapp({ a_op = Efun _ } as op, e_list, _) -> let args,_ = mapfold (Hept_mapfold.exp_it funs) acc e_list in - let re,_ = optional_wacc (Hept_mapfold.exp_it funs) acc re in Eapp(op, args, None), acc (* funs don't need resets *) - | Eiterator(it, ({ a_op = Efun _ } as op), n, pe_list, e_list, re) -> + | Eiterator(it, ({ a_op = Efun _ } as op), n, pe_list, e_list, _) -> let pargs,_ = mapfold (Hept_mapfold.exp_it funs) acc pe_list in let args,_ = mapfold (Hept_mapfold.exp_it funs) acc e_list in - let re,_ = optional_wacc (Hept_mapfold.exp_it funs) acc re in Eiterator(it, op, n, pargs, args, None), acc (* funs don't need resets *) | _ -> raise Errors.Fallback diff --git a/compiler/main/hept2mls.ml b/compiler/main/hept2mls.ml index 42cda98..2f328e8 100644 --- a/compiler/main/hept2mls.ml +++ b/compiler/main/hept2mls.ml @@ -91,7 +91,7 @@ let rec translate_extvalue e = | Heptagon.Ewhen (e, c, x) -> mk_extvalue (Wwhen (translate_extvalue e, c, x)) | Heptagon.Eapp({ Heptagon.a_op = Heptagon.Efield; - Heptagon.a_params = params }, e_list, reset) -> + Heptagon.a_params = params }, e_list, _) -> let e = assert_1 e_list in let f = assert_1 params in let fn = match f.se_desc with Sfield fn -> fn | _ -> assert false in diff --git a/compiler/main/mls2obc.ml b/compiler/main/mls2obc.ml index 25a616e..c8fc915 100644 --- a/compiler/main/mls2obc.ml +++ b/compiler/main/mls2obc.ml @@ -178,7 +178,7 @@ let rec translate_extvalue map w = | Minils.Wfield (w1, f) -> let e = translate_extvalue map w1 in Epattern (mk_pattern w.Minils.w_ty (Lfield (pattern_of_exp e, f))) - | Minils.Wwhen (w1, c, x) -> + | Minils.Wwhen (w1, c, _) -> let e1 = translate_extvalue map w1 in e1.e_desc in @@ -441,7 +441,7 @@ and mk_node_call map call_context app loc name_list args ty = let e = mk_exp ty (Eop(f, args)) in Aassgn (name, e) | _ -> - Misc.unsupported "mls2obc: external function with multiple return values" 1 in + Misc.unsupported "mls2obc: external function with multiple return values" in [], [], [], [act] | Minils.Enode f when Itfusion.is_anon_node f -> diff --git a/compiler/main/mls2seq.ml b/compiler/main/mls2seq.ml index 1484058..c0f3d83 100644 --- a/compiler/main/mls2seq.ml +++ b/compiler/main/mls2seq.ml @@ -47,10 +47,10 @@ let targets = [ "c",(Obc_no_params Cmain.program, no_conf); "epo", (Minils write_object_file, no_conf) ] let generate_target p s = - let print_unfolded p_list = +(* let print_unfolded p_list = comment "Unfolding"; if !Compiler_options.verbose - then List.iter (Mls_printer.print stderr) p_list in + then List.iter (Mls_printer.print stderr) p_list in*) let target = (try fst (List.assoc s targets) with Not_found -> language_error s; raise Errors.Error) in diff --git a/compiler/minils/analysis/clocking.ml b/compiler/minils/analysis/clocking.ml index 8e02919..78a45b9 100644 --- a/compiler/minils/analysis/clocking.ml +++ b/compiler/minils/analysis/clocking.ml @@ -65,7 +65,7 @@ let rec typing_extvalue h w = let ck_n = ck_of_name h n in expect_extvalue h ck_n w1; Con (ck_n, c, n) - | Wfield (w1, f) -> + | Wfield (w1, _) -> typing_extvalue h w1 in w.w_ck <- ck; @@ -143,21 +143,11 @@ let typing_eq h { eq_lhs = pat; eq_rhs = e; eq_loc = loc } = let ck = fresh_clock () in List.iter (fun (_, e) -> expect_extvalue h ck e) l; Ck ck, ck - | Eapp({a_op = op}, args, r) -> - (* (* base clock of the node have to be a sub-clock of the reset clock *) - let base_ck = match r with - | None -> fresh_clock () - | Some(reset) -> ck_of_name h reset - in *) + | Eapp({a_op = op}, args, _) -> (* hyperchronous reset *) let base_ck = fresh_clock () in let ct = typing_app h base_ck pat op args in ct, base_ck - | Eiterator (it, {a_op = op}, _, pargs, args, r) -> - (* (* base clock of the node *) - let base_ck = match r with - | None -> fresh_clock () - | Some(reset) -> ck_of_name h reset - in *) + | Eiterator (it, {a_op = op}, _, pargs, args, _) -> (* hyperchronous reset *) let base_ck = fresh_clock() in let ct = match it with | Imap -> (* exactly as if clocking the node *) diff --git a/compiler/minils/transformations/callgraph.ml b/compiler/minils/transformations/callgraph.ml index e41367b..22e23f2 100644 --- a/compiler/minils/transformations/callgraph.ml +++ b/compiler/minils/transformations/callgraph.ml @@ -261,7 +261,7 @@ let node_by_longname node = let n = List.find (function Pnode n -> n.n_name = node | _ -> false) p.p_desc in (match n with | Pnode n -> n - | _ -> Misc.internal_error "callgraph" 0) + | _ -> Misc.internal_error "callgraph") with Not_found -> Error.message no_location (Error.Enode_unbound node) diff --git a/compiler/obc/control.ml b/compiler/obc/control.ml index 9fe3dfc..a9ac0bb 100644 --- a/compiler/obc/control.ml +++ b/compiler/obc/control.ml @@ -59,7 +59,7 @@ and joinhandlers h1 h2 = with Not_found -> s1, h2 in (c1, join_block s1') :: joinhandlers h1' h2' -let block funs acc b = +let block _ acc b = { b with b_body = joinlist b.b_body }, acc let program p = diff --git a/compiler/obc/java/obc2java.ml b/compiler/obc/java/obc2java.ml index 07376a5..9e15df5 100644 --- a/compiler/obc/java/obc2java.ml +++ b/compiler/obc/java/obc2java.ml @@ -102,7 +102,7 @@ let rec static_exp param_env se = match se.Types.se_desc with | Types.Sbool b -> Sbool b | Types.Sstring s -> Sstring s | Types.Sconstructor c -> let c = translate_constructor_name c in Sconstructor c - | Types.Sfield f -> eprintf "ojSfield @."; assert false; + | Types.Sfield _ -> eprintf "ojSfield @."; assert false; | Types.Stuple se_l -> tuple param_env se_l | Types.Sarray_power (see,pow) -> let pow = (try Static.int_of_static_exp Names.QualEnv.empty pow @@ -376,8 +376,8 @@ let type_dec_list classes td_l = let classe_name = qualname_to_package_classe td.t_name in Idents.enter_node classe_name; match td.t_desc with - | Type_abs -> Misc.unsupported "obc2java, abstract type." 1 - | Type_alias _ -> Misc.unsupported "obc2java, type alias." 2 + | Type_abs -> Misc.unsupported "obc2java, abstract type." + | Type_alias _ -> Misc.unsupported "obc2java, type alias." | Type_enum c_l -> let mk_constr_enum c = translate_constructor_name_2 c td.t_name in (mk_enum (List.map mk_constr_enum c_l) classe_name) :: classes