jeltz/heptagon
1
0
Fork 0
Code Issues Pull requests Releases Activity

Changed compile flags, and cleaned a bit.

Browse source 
Warn as error for partial match.
Warn for unused variables : added some TODO to check.
PS : I'll deal with callgraph which is doing things that Modules does.
This commit is contained in:
Léonard Gérard 2010-09-14 09:39:02 +02:00
parent 4a5c9130e7
commit 02db2ad6b4
27 changed files with 87 additions and 103 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
compiler/global/clocks.ml
View file

@ -98,7 +98,7 @@ let rec skeleton ck = function
| _ -> Cprod (List.map (skeleton ck) ty_list))
| Tarray _ | Tid _ -> Ck ck
let ckofct = function | Ck ck -> ck_repr ck | Cprod ct_list -> Cbase
let ckofct = function | Ck ck -> ck_repr ck | Cprod _ -> Cbase (*TODO bug ?*)

2
compiler/global/global_mapfold.ml
View file

@ -127,7 +127,7 @@ let defaults = {
(** Is used to stop the pass at this level *)
let stop funs acc x = x, acc
let stop _ acc x = x, acc
let defaults_stop = {
static_exp = stop;

2
compiler/global/global_printer.ml
View file

@ -97,7 +97,7 @@ let print_interface_value ff name node =
node.node_params_constraints
let print_interface ff i =
let print_interface ff =
let m = Modules.current_module () in
NamesEnv.iter
(fun key typdesc -> print_interface_type ff key typdesc) m.m_types;

7
compiler/heptagon/analysis/causality.ml
View file

@ -62,7 +62,7 @@ let rec pre = function
| Cand(c1, c2) -> Cand(pre c1, pre c2)
| Ctuple l -> Ctuple (List.map pre l)
| Cseq(c1, c2) -> Cseq(pre c1, pre c2)
| Cread(x) -> Cempty
| Cread _ -> Cempty
| (Cwrite _ | Clastread _ | Cempty) as c -> c
(* projection and restriction *)
@ -94,7 +94,7 @@ let build dec =
(** Main typing function *)
let rec typing e =
match e.e_desc with
| Econst(c) -> cempty
| Econst _ -> cempty
| Evar(x) -> read x
| Elast(x) -> lastread x
| Epre (_, e) -> pre (typing e)
@ -201,8 +201,7 @@ let typing_contract loc contract =
let t_contract = clear (build b.b_local) t_contract in
t_contract
let typing_node { n_name = f; n_input = i_list; n_output = o_list;
n_contract = contract;
let typing_node { n_contract = contract;
n_block = b; n_loc = loc } =
let _ = typing_contract loc contract in
ignore (typing_block b)

34
compiler/heptagon/analysis/typing.ml
View file

@ -255,18 +255,6 @@ let name_mem n env =
in
Env.fold check_one env false
(*let rec simplify_type = function
| Tid _ as t -> t
| Tarray(ty, e) ->
Tarray(simplify_type ty, simplify NamesEnv.empty e)
| Tprod l ->
Tprod (List.map simplify_type l)
let simplify_type loc ty =
try
simplify_type ty
with
Instanciation_failed -> message loc (Etype_should_be_static ty) *)
let build_subst names values =
if List.length names <> List.length values
@ -386,7 +374,7 @@ let check_static_field_unicity l =
[loc] is the location used for error reporting.*)
let struct_info_from_name n =
try
n, find_struct n
find_struct n
with
Not_found -> error (Erecord_type_expected (Tid n))
@ -403,7 +391,8 @@ let struct_info ty = match ty with
[loc] is the location used for error reporting.*)
let struct_info_from_field f =
try
struct_info_from_name (find_field f)
let t = find_field f in
t, struct_info_from_name t
with
Not_found -> error (Eundefined (fullname f))
@ -456,7 +445,7 @@ and typing_static_exp const_env se =
let q, fields =
(match f_se_list with
| [] -> error (Eempty_record)
| (f,_)::l -> struct_info_from_field f
| (f,_)::_ -> struct_info_from_field f
) in
if List.length f_se_list <> List.length fields then
@ -523,7 +512,7 @@ let rec typing const_env h e =
let q, fields =
(match l with
| [] -> message e.e_loc (Eempty_record)
| (f,_)::l -> struct_info_from_field f
| (f,_)::_ -> struct_info_from_field f
) in
if List.length l <> List.length fields then
@ -553,7 +542,6 @@ let rec typing const_env h e =
n, e_list, reset) ->
let ty_desc = find_value f in
let op, expected_ty_list, result_ty_list = kind f ty_desc in
(*TODO verifier....*)
let node_params =
List.map (fun { p_name = n } -> local_qn n) ty_desc.node_params in
let m = build_subst node_params params in
@ -620,7 +608,6 @@ and typing_app const_env h op e_list =
| { a_op = (Efun f | Enode f); a_params = params } as app ->
let ty_desc = find_value f in
let op, expected_ty_list, result_ty_list = kind f ty_desc in
(*TODO verifier....*)
let node_params =
List.map (fun { p_name = n } -> local_qn n) ty_desc.node_params in
let m = build_subst node_params params in
@ -658,7 +645,7 @@ and typing_app const_env h op e_list =
| Sfield fn -> fn
| _ -> assert false) in
let typed_e, t1 = typing const_env h e in
let q, fields = struct_info t1 in
let fields = struct_info t1 in
let t2 = field_type const_env fn fields t1 e.e_loc in
t2, op, [typed_e]
@ -666,7 +653,7 @@ and typing_app const_env h op e_list =
let e1, e2 = assert_2 e_list in
let f = assert_1 params in
let typed_e1, t1 = typing const_env h e1 in
let q, fields = struct_info t1 in
let fields = struct_info t1 in
let fn =
(match f.se_desc with
| Sfield fn -> fn
@ -803,7 +790,7 @@ and typing_array_subscript const_env h idx_list ty =
and typing_array_subscript_dyn const_env h idx_list ty =
match unalias_type ty, idx_list with
| ty, [] -> ty, []
| Tarray(ty, exp), idx::idx_list ->
| Tarray(ty, _), idx::idx_list ->
let typed_idx = expect const_env h (Tid Initial.pint) idx in
let ty, typed_idx_list =
typing_array_subscript_dyn const_env h idx_list ty in
@ -890,7 +877,7 @@ and typing_automaton_handlers const_env h acc state_handlers =
let typed_e = expect const_env h (Tid Initial.pbool) e in
{ esc with e_cond = typed_e } in
let handler ({ s_state = n; s_block = b; s_until = e_list1;
let handler ({ s_block = b; s_until = e_list1;
s_unless = e_list2 } as s) =
let typed_b, defined_names, h0 = typing_block const_env h b in
let typed_e_list1 = List.map (escape h0) e_list1 in
@ -1018,8 +1005,7 @@ let build_node_params const_env l =
in
mapfold check_param const_env l
let node ({ n_name = f; n_statefull = statefull;
n_input = i_list; n_output = o_list;
let node ({ n_name = f; n_input = i_list; n_output = o_list;
n_contract = contract;
n_block = b; n_loc = loc;
n_params = node_params; } as n) =

3
compiler/heptagon/hept_printer.ml
View file

@ -111,7 +111,6 @@ and print_exp_desc ff = function
print_static_exp param
print_exp_tuple args
print_every reset
| Eiterator _ -> assert false
and print_every ff reset =
print_opt (fun ff id -> fprintf ff " every %a" print_exp id) ff reset
@ -230,7 +229,7 @@ and print_eq_list ff = function
| [] -> ()
| l -> print_list_r print_eq """;""" ff l
and print_block ff { b_local = v_list; b_equs = eqs; b_defnames = defnames } =
and print_block ff { b_local = v_list; b_equs = eqs } =
fprintf ff "%a@[<v2>do@ %a@]" print_local_vars v_list print_eq_list eqs
let rec print_type_def ff { t_name = name; t_desc = tdesc } =

6
compiler/heptagon/main/hept_compiler.ml
View file

@ -40,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 p;
if !print_types then print_interface Format.std_formatter;
(* Causality check *)
let p = silent_pass "Causality check" true Causality.program p in
@ -92,8 +92,8 @@ let compile_interface modname filename =
let l = do_silent_pass "Parsing" parse_interface lexbuf in
(* Convert the parse tree to Heptagon AST *)
let l = do_silent_pass "Scoping" Hept_scoping.translate_interface l in
if !print_types then print_interface Format.std_formatter l;
let _ = do_silent_pass "Scoping" Hept_scoping.translate_interface l in
if !print_types then print_interface Format.std_formatter;
output_value itc (Modules.current_module ());

8
compiler/heptagon/parsing/hept_lexer.mll
View file

@ -5,13 +5,7 @@
open Lexing
open Location
open Hept_parser
type lexical_error =
Illegal_character
| Unterminated_comment
| Bad_char_constant
| Unterminated_string;;
open Compiler_utils
exception Lexical_error of lexical_error * location;;

2
compiler/heptagon/transformations/completion.ml
View file

@ -21,7 +21,7 @@ open Idents
*)
(* We stop at the first level, it'll correspond to an handler *)
let block_collect funs env b =
let block_collect _ _ b =
b, b.b_defnames
let gather f funs env x =

4
compiler/heptagon/transformations/last.ml
View file

@ -27,7 +27,7 @@ let last (eq_list, env, v) { v_ident = n; v_type = t; v_last = last } =
let extend_env env v = List.fold_left last ([], env, []) v
let edesc funs env ed = match ed with
let edesc _ env ed = match ed with
| Elast x ->
let lx = Env.find x env in Evar lx, env
| _ -> raise Misc.Fallback
@ -38,7 +38,7 @@ let block funs env b =
{ b with b_local = b.b_local @ last_v;
b_equs = eq_lastn_n_list @ b.b_equs }, env
let node_dec funs env n =
let node_dec funs _ n =
let _, env, _ = extend_env Env.empty n.n_input in
let eq_lasto_list, env, last_o = extend_env env n.n_output in
let n, _ = Hept_mapfold.node_dec funs env n in

4
compiler/heptagon/transformations/reset.ml
View file

@ -82,7 +82,7 @@ let equation v acc_eq_list e =
let orthen v acc_eq_list res e =
match e.e_desc with
| Evar n -> add_resets res (Some e), v, acc_eq_list
| Evar _ -> add_resets res (Some e), v, acc_eq_list
| _ ->
let n, v, acc_eq_list = equation v acc_eq_list e in
add_resets res (Some { e with e_desc = Evar n }), v, acc_eq_list
@ -180,7 +180,7 @@ let eq funs (res, v, acc_eq_list) equ =
equ, (res, v, equ::acc_eq_list)
let block funs _ b =
let n, (_, v, eq_list) = Hept_mapfold.block funs (None, [], []) b in
let _, (_, v, eq_list) = Hept_mapfold.block funs (None, [], []) b in
{ b with b_local = v @ b.b_local; b_equs = eq_list; }, (None, [], [])
let program p =

20
compiler/main/hept2mls.ml
View file

@ -84,7 +84,7 @@ struct
let ck_tag_name = Con(ck, tag, name) in
{ e with e_desc = Ewhen(e, tag, name); e_ck = ck_tag_name },
ck_tag_name
| Ecomp(env, l) -> constrec env in
| Ecomp(env, _) -> constrec env in
let e, _ = constrec env in e
end
@ -149,12 +149,12 @@ let switch x ci_eqs_list =
| _ ->
let firsts,nexts = extract eqs_lists in
(* check all firsts defining same name *)
if (List.for_all (fun (x,e) -> x = (fst (List.hd firsts))) firsts)
if (List.for_all (fun (x,_) -> x = (fst (List.hd firsts))) firsts)
then ()
else
begin
List.iter
(fun (x,e) -> Format.eprintf "|%s|, " (name x))
(fun (x,_) -> Format.eprintf "|%s|, " (name x))
firsts;
assert false
end;
@ -168,14 +168,14 @@ let switch x ci_eqs_list =
let rec split ci_eqs_list =
match ci_eqs_list with
| [] | (_, []) :: _ -> [], []
| (ci, (y, e) :: shared_eq_list) :: ci_eqs_list ->
| (ci, (_, e) :: shared_eq_list) :: ci_eqs_list ->
let ci_e_list, ci_eqs_list = split ci_eqs_list in
(ci, e) :: ci_e_list, (ci, shared_eq_list) :: ci_eqs_list in
let rec distribute ci_eqs_list =
match ci_eqs_list with
| [] | (_, []) :: _ -> []
| (ci, (y, { e_ty = ty; e_loc = loc }) :: _) :: _ ->
| (_, (y, { e_ty = ty; e_loc = loc }) :: _) :: _ ->
let ci_e_list, ci_eqs_list = split ci_eqs_list in
(y, mk_exp ~exp_ty:ty ~loc:loc (Emerge(x, ci_e_list))) ::
distribute ci_eqs_list in
@ -194,7 +194,7 @@ let translate_iterator_type = function
| Heptagon.Ifoldi -> Ifoldi
| Heptagon.Imapfold -> Imapfold
let rec translate_op env = function
let rec translate_op = function
| Heptagon.Eequal -> Eequal
| Heptagon.Eifthenelse -> Eifthenelse
| Heptagon.Efun f -> Efun f
@ -212,9 +212,9 @@ let rec translate_op env = function
| Heptagon.Earrow ->
Error.message no_location Error.Eunsupported_language_construct
let translate_app env app =
let translate_app app =
mk_app ~params:app.Heptagon.a_params
~unsafe:app.Heptagon.a_unsafe (translate_op env app.Heptagon.a_op)
~unsafe:app.Heptagon.a_unsafe (translate_op app.Heptagon.a_op)
let rec translate env
{ Heptagon.e_desc = desc; Heptagon.e_ty = ty;
@ -235,13 +235,13 @@ let rec translate env
(fun (f, e) -> (f, translate env e)) f_e_list in
mk_exp ~loc:loc ~exp_ty:ty (Estruct f_e_list)
| Heptagon.Eapp(app, e_list, reset) ->
mk_exp ~loc:loc ~exp_ty:ty (Eapp (translate_app env app,
mk_exp ~loc:loc ~exp_ty:ty (Eapp (translate_app app,
List.map (translate env) e_list,
translate_reset reset))
| Heptagon.Eiterator(it, app, n, e_list, reset) ->
mk_exp ~loc:loc ~exp_ty:ty
(Eiterator (translate_iterator_type it,
translate_app env app, n,
translate_app app, n,
List.map (translate env) e_list,
translate_reset reset))
| Heptagon.Efby _

5
compiler/main/mls2obc.ml
View file

@ -63,7 +63,7 @@ let rec translate_pat map = function
List.fold_right (fun pat acc -> (translate_pat map pat) @ acc)
pat_list []
let translate_var_dec map l =
let translate_var_dec map l = (*TODO bug map unused ?*)
let one_var { Minils.v_ident = x; Minils.v_type = t; v_loc = loc } =
mk_var_dec ~loc:loc x t
in
@ -238,8 +238,7 @@ let empty_call_context = Oobj "n", None
let rec translate_eq map call_context { Minils.eq_lhs = pat; Minils.eq_rhs = e }
(v, si, j, s) =
let { Minils.e_desc = desc; Minils.e_ty = ty;
Minils.e_ck = ck; Minils.e_loc = loc } = e in
let { Minils.e_desc = desc; Minils.e_ck = ck; Minils.e_loc = loc } = e in
match (pat, desc) with
| Minils.Evarpat n, Minils.Efby (opt_c, e) ->
let x = var_from_name map n in

7
compiler/minils/analysis/clocking.ml
View file

@ -37,7 +37,7 @@ let rec typing h e =
let ct = match e.e_desc with
| Econst se -> skeleton (new_var ()) se.se_ty
| Evar x -> Ck (typ_of_name h x)
| Efby (c, e) -> typing h e
| Efby (_, e) -> typing h e
| Eapp({a_op = op}, args, r) ->
let ck = match r with
| None -> new_var ()
@ -57,7 +57,7 @@ let rec typing h e =
| Estruct l ->
let ck = new_var () in
(List.iter
(fun (n, e) -> let ct = skeleton ck e.e_ty in expect h ct e) l;
(fun (_, e) -> let ct = skeleton ck e.e_ty in expect h ct e) l;
Ck ck)
in (e.e_ck <- ckofct ct; ct)
@ -147,8 +147,7 @@ let typing_contract h contract base =
expect h' (Ck base) e_g;
h)
let typing_node ({ n_name = f;
n_input = i_list;
let typing_node ({ n_input = i_list;
n_output = o_list;
n_contract = contract;
n_local = l_list;

2
compiler/minils/mls_printer.ml
View file

@ -31,7 +31,7 @@ let rec print_ck ff = function
| Cbase -> fprintf ff "base"
| Con (ck, c, n) ->
fprintf ff "%a on %a(%a)" print_ck ck print_qualname c print_ident n
| Cvar { contents = Cindex n } -> fprintf ff "base"
| Cvar { contents = Cindex _ } -> fprintf ff "base"
| Cvar { contents = Clink ck } -> print_ck ff ck
let rec print_clock ff = function

11
compiler/minils/mls_utils.ml
View file

@ -15,7 +15,8 @@ type err_kind = | Enot_static_exp
let err_message ?(exp=void) ?(loc=exp.e_loc) = function
| Enot_static_exp ->
Format.eprintf "The expression %a should be a static_exp.@."
Format.eprintf "%aThe expression %a should be a static_exp.@."
print_location loc
print_exp exp;
raise Error
@ -70,7 +71,7 @@ struct
| Etuplepat pat_list -> List.fold_left vars_pat acc pat_list
let rec vars_ck acc = function
| Con(ck, c, n) -> add n acc
| Con(_, _, n) -> add n acc
| Cbase | Cvar { contents = Cindex _ } -> acc
| Cvar { contents = Clink ck } -> vars_ck acc ck
@ -123,7 +124,7 @@ struct
let rec headrec ck l =
match ck with
| Cbase | Cvar { contents = Cindex _ } -> l
| Con(ck, c, n) -> headrec ck (n :: l)
| Con(ck, _, n) -> headrec ck (n :: l)
| Cvar { contents = Clink ck } -> headrec ck l
in
headrec ck []
@ -136,7 +137,7 @@ struct
end
let node_memory_vars n =
let eq funs acc ({ eq_lhs = pat; eq_rhs = e } as eq) =
let eq _ acc ({ eq_lhs = pat; eq_rhs = e } as eq) =
match e.e_desc with
| Efby(_, _) -> eq, Vars.vars_pat acc pat
| _ -> eq, acc
@ -160,5 +161,5 @@ module AllDep = Dep.Make
type equation = eq
let read eq = Vars.read false eq
let def = Vars.def
let antidep eq = false
let antidep _ = false
end)

7
compiler/minils/parsing/mls_lexer.mll
View file

@ -5,12 +5,7 @@
open Location
open Lexing
open Mls_parser
type lexical_error =
Illegal_character
| Unterminated_comment
| Bad_char_constant
| Unterminated_string;;
open Compiler_utils
exception Lexical_error of lexical_error * location;;

10
compiler/minils/transformations/callgraph.ml
View file

@ -239,11 +239,11 @@ let load_object_file modname =
(** @return the node with name [ln], loading the corresponding
object file if necessary. *)
let node_by_longname ({ qual = q; name = n } as node) =
if not (NamesEnv.mem q info.opened)
then load_object_file q;
let node_by_longname node =
if not (NamesEnv.mem node.qual info.opened)
then load_object_file node.qual;
try
let p = NamesEnv.find q info.opened in
let p = NamesEnv.find node.qual info.opened in
List.find (fun n -> n.n_name = node) p.p_nodes
with
Not_found -> Error.message no_location (Error.Enode_unbound node)
@ -259,7 +259,7 @@ let collect_node_calls ln =
| { qual = "Pervasives" } -> acc
| _ -> (ln, params)::acc)
in
let edesc funs acc ed = match ed with
let edesc _ acc ed = match ed with
| Eapp ({ a_op = (Enode ln | Efun ln); a_params = params }, _, _) ->
ed, add_called_node ln params acc
| Eiterator(_, { a_op = (Enode ln | Efun ln); a_params = params },

2
compiler/minils/transformations/normalize.ml
View file

@ -89,7 +89,7 @@ let rec merge e x ci_a_list =
let rec distribute ci_tas_list =
match ci_tas_list with
| [] | (_, _, []) :: _ -> []
| (ci, b, (eo :: _)) :: _ ->
| (_, b, (eo :: _)) :: _ ->
let ci_ta_list, ci_tas_list = split ci_tas_list in
let ci_tas_list = distribute ci_tas_list in
(if b then

2
compiler/minils/transformations/schedule.ml
View file

@ -77,7 +77,7 @@ let eqs funs () eq_list =
let eqs, () = Mls_mapfold.eqs funs () eq_list in
schedule eqs, ()
let edesc funs () = function
let edesc _ () = 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

2
compiler/myocamlbuild.ml
View file

@ -33,6 +33,8 @@ let df = function
flag ["ocaml"; "parser" ; "menhir" ; "use_menhir"] (S[A"--explain";
A"--table"]);
flag ["ocaml"; "compile" ] (S[A"-w"; A"Ae"; A"-warn-error"; A"PU"]);
| _ -> ()
let _ = dispatch df

8
compiler/obc/c/c.ml
View file

@ -190,14 +190,14 @@ let rec pp_array_decl cty =
| _ -> cty, ""
let rec pp_param_cty fmt = function
| Cty_arr(n, cty') ->
| Cty_arr(_, cty') ->
fprintf fmt "%a*" pp_param_cty cty'
| cty -> pp_cty fmt cty
(* pp_vardecl, featuring an ugly hack coping with C's inconsistent concrete
syntax! *)
let rec pp_vardecl fmt (s, cty) = match cty with
| Cty_arr (n, cty') ->
| Cty_arr _ ->
let ty, indices = pp_array_decl cty in
fprintf fmt "%a %a%s" pp_cty ty pp_string s indices
| _ -> fprintf fmt "%a %a" pp_cty cty pp_string s
@ -349,6 +349,6 @@ let is_pointer_type = function
then it returns a[i1]..[ip]. *)
let rec array_base_ctype ty idx_list =
match ty, idx_list with
| Cty_arr (n, ty), [i] -> ty
| Cty_arr (n, ty), i::idx_list -> array_base_ctype ty idx_list
| Cty_arr (_, ty), [_] -> ty
| Cty_arr (_, ty), _::idx_list -> array_base_ctype ty idx_list
| _ -> assert false

11
compiler/obc/c/cgen.ml
View file

@ -231,7 +231,7 @@ let rec cexpr_of_static_exp se =
| Sint i -> Cconst (Ccint i)
| Sfloat f -> Cconst (Ccfloat f)
| Sbool b -> Cconst (Ctag (if b then "TRUE" else "FALSE"))
| Sfield f -> assert false
| Sfield _ -> assert false
| Sconstructor c -> Cconst (Ctag (cname_of_qn c))
| Sarray sl -> Carraylit (List.map cexpr_of_static_exp sl)
| Sarray_power(n,c) ->
@ -274,7 +274,7 @@ let rec cexpr_of_exp var_env exp =
and cexprs_of_exps var_env exps =
List.map (cexpr_of_exp var_env) exps
and cop_of_op_aux var_env op_name cexps = match op_name with
and cop_of_op_aux op_name cexps = match op_name with
| { qual = "Pervasives"; name = op } ->
begin match op,cexps with
| "~-", [e] -> Cuop ("-", e)
@ -288,12 +288,11 @@ and cop_of_op_aux var_env op_name cexps = match op_name with
Cbop (copname op, el, er)
| _ -> Cfun_call(op, cexps)
end
| {qual = m; name = op} ->
Cfun_call(op,cexps)
| {qual = m; name = op} -> Cfun_call(op,cexps) (*TODO m should be used?*)
and cop_of_op var_env op_name exps =
let cexps = cexprs_of_exps var_env exps in
cop_of_op_aux var_env op_name cexps
cop_of_op_aux op_name cexps
and clhs_of_lhs var_env l = match l.l_desc with
(** Each Obc variable corresponds to a real local C variable. *)
@ -369,7 +368,7 @@ let generate_function_call var_env obj_env outvl objn args =
let fun_call =
if is_op classln then
cop_of_op_aux var_env classln args
cop_of_op_aux classln args
else
(** The step function takes scalar arguments and its own internal memory
holding structure. *)

4
compiler/obc/c/cmain.ml
View file

@ -160,7 +160,7 @@ let main_def_of_class_def cd =
:: ep))],
match nbuf_opt with
| None -> []
| Some id -> [(varn, Cty_arr (20, Cty_char))]) in
| Some _ -> [(varn, Cty_arr (20, Cty_char))]) in
let stepm = find_step_method cd in
let (scanf_calls, scanf_decls) =
@ -270,7 +270,7 @@ let mk_main name p = match (!Misc.simulation_node, !Misc.assert_nodes) with
(var @ var_l, res :: res_l, step :: step_l) in
List.fold_right add a_classes ([], [], []) in
let (deps, var_l, res_l, step_l) =
let (_, var_l, res_l, step_l) =
(match !Misc.simulation_node with
| None -> (n_names, var_l, res_l, step_l)
| Some n ->

2
compiler/obc/control.ml
View file

@ -46,7 +46,7 @@ let is_deadcode = function
| Elhs l -> l = lhs
| _ -> false
)
| Acase (e, []) -> true
| Acase (_, []) -> true
| Afor(_, _, _, { b_body = [] }) -> true
| _ -> false

15
compiler/utilities/global/compiler_utils.ml
View file

@ -10,8 +10,19 @@ open Misc
open Location
open Minils
type lexical_error =
| Illegal_character
| Unterminated_comment
| Bad_char_constant
| Unterminated_string
let lexical_error err loc =
Format.eprintf "%aIllegal character.@." print_location loc;
Format.eprintf (match err with
| Illegal_character -> Pervasives.format_of_string "%aIllegal character.@."
| Unterminated_comment -> "%aUnterminated comment.@."
| Bad_char_constant -> "%aBad char constant.@."
| Unterminated_string -> "%aUnterminated string.@."
) print_location loc;
raise Error
let syntax_error loc =
@ -34,7 +45,7 @@ let do_pass d f p pp =
comment ~sep:"*** " (d^" done.");
r
let do_silent_pass d f p = do_pass d f p (fun x -> ())
let do_silent_pass d f p = do_pass d f p (fun _ -> ())
let pass d enabled f p pp =
if enabled

8
compiler/utilities/misc.ml
View file

@ -151,9 +151,9 @@ let print_header_info ff cbeg cend =
cend
let unique l =
let tbl = Hashtbl.create 10 in (* You could replace 10 with List.length l *)
let tbl = Hashtbl.create (List.length l) in
List.iter (fun i -> Hashtbl.replace tbl i ()) l;
Hashtbl.fold (fun key data accu -> key :: accu) tbl []
Hashtbl.fold (fun key _ accu -> key :: accu) tbl []
let rec incomplete_map f l =
match l with
@ -165,7 +165,7 @@ let rec last_element l =
match l with
| [] -> assert false
| [v] -> v
| v::l -> last_element l
| _::l -> last_element l
(** [split_last l] returns l without its last element and
the last element of l. *)
@ -204,7 +204,7 @@ let repeat_list v n =
(** Same as List.mem_assoc but using the value instead of the key. *)
let rec memd_assoc value = function
| [] -> false
| (k,d)::l -> (d = value) or (memd_assoc value l)
| (_,d)::l -> (d = value) or (memd_assoc value l)
(** Same as List.assoc but searching for a data and returning the key. *)
let rec assocd value = function