diff --git a/remove_unused_variables.sh b/remove_unused_variables.sh new file mode 100755 index 000000000..36c9f8c83 --- /dev/null +++ b/remove_unused_variables.sh @@ -0,0 +1,44 @@ +#!/bin/sh + +set -ue + +if [ -z "$1" ] || [ -z "$2" ] || [ -z "$3" ]; then + echo "Usage: $0 \ + " + exit 1 +fi + +var_file="$1" +code_base="$2" +sql_file="$3" + +if [ ! -f "$var_file" ]; then + echo "The file $var_file does not exist" + exit 2 +fi +if [ -f "$sql_file" ] && [ ! -s "$sql_file" ]; then + echo "The file $sql_file exists and is not empty" + exit 3 +fi + +counter=0 + +while IFS= read -r var; do + if [ -z "$var" ]; then + continue + fi + + echo "Processing variable $var" + + grep -lE "^${var}[^(A-Z|a-z|0-9|_)]" "$code_base/*.m" | while IFS= read -r file + do + awk "/^$var([^a-zA-Z0-9_]|$)/ {f=1} f {if (/;/) {f=0} next} 1" "$file" > temp && mv temp "$file" + done + +# La ligne suivante suppose une modification des makefiles pour tester sur une version en cours de développement de Mlang + YEAR=2024 TEST_FILE=tests/dummy.irj make test + counter=$((counter + 1)) && echo $counter + echo "delete from dico_24 where variable='$var';" >> "$sql_file" +done < "$var_file" + +echo "Done" diff --git a/src/mlang/driver.ml b/src/mlang/driver.ml index c3ea6a278..418b5dcd7 100644 --- a/src/mlang/driver.ml +++ b/src/mlang/driver.ml @@ -197,6 +197,7 @@ let driver (files : string list) (application_names : string list) Cli.debug_print "Elaborating..."; let m_program = Mast_to_mir.translate !m_program mpp_function in let m_program = Mir.expand_functions m_program in + Mir_collect.warn_unused_variables m_program.program_targets; Cli.debug_print "Creating combined program suitable for execution..."; if run_all_tests <> None then let tests : string = diff --git a/src/mlang/dune b/src/mlang/dune index 44f12dbe2..99b241281 100644 --- a/src/mlang/dune +++ b/src/mlang/dune @@ -3,7 +3,7 @@ (library (public_name mlang) (libraries re ANSITerminal parmap cmdliner threads dune-build-info num gmp - menhirLib)) + ocamlgraph menhirLib)) (documentation (package mlang) diff --git a/src/mlang/m_frontend/check_validity.ml b/src/mlang/m_frontend/check_validity.ml index f6dcf7cdc..e382432d7 100644 --- a/src/mlang/m_frontend/check_validity.ml +++ b/src/mlang/m_frontend/check_validity.ml @@ -675,6 +675,7 @@ let check_var_decl (var_decl : Mast.variable_decl) (prog : program) : program = ~attrs:(get_attributes input_var.Mast.input_attributes) ~cat:global_category ~typ:(Option.map Pos.unmark input_var.Mast.input_typ) + ~in_verif:false in check_global_var var prog | Mast.ComputedVar (comp_var, _decl_pos) -> @@ -699,6 +700,7 @@ let check_var_decl (var_decl : Mast.variable_decl) (prog : program) : program = ~attrs:(get_attributes comp_var.Mast.comp_attributes) ~cat:global_category ~typ:(Option.map Pos.unmark comp_var.Mast.comp_typ) + ~in_verif:false in check_global_var var prog @@ -828,6 +830,36 @@ let check_verif_dom_decl (decl : Mast.verif_domain_decl) (prog : program) : let doms, syms = check_domain Verif decl dom_data doms_syms in { prog with prog_vdoms = doms; prog_vdom_syms = syms } +let warn_on_undef_computed_vars (rules : rule IntMap.t) + (vars : Com.Var.t StrMap.t) = + let def_vars = + IntMap.fold + (fun _ rule set -> + List.fold_left + (fun set m_instr -> + let instr = Pos.unmark m_instr in + match instr with + | Com.Affectation m_formula -> begin + let formula = Pos.unmark m_formula in + match formula with + | Com.SingleFormula (var, _, _) -> + StrSet.add (Mast.get_variable_name (Pos.unmark var)) set + | Com.MultipleFormulaes _ -> assert false + end + | _ -> set) + set rule.rule_instrs) + rules StrSet.empty + in + StrMap.iter + (fun var_name var -> + match Com.Var.cat var with + | Computed _ -> + if not (StrSet.mem var_name def_vars) then + Cli.warning_print + "Variable %s is declared as computed but never defined" var_name + | Input _ -> ()) + vars + let complete_vars (prog : program) : program = let prog_vars = prog.prog_vars in let prog_vars = @@ -1058,6 +1090,7 @@ let complete_vars (prog : program) : program = sz_all_tmps; } in + warn_on_undef_computed_vars prog.prog_rules prog_vars; { prog with prog_vars; prog_targets; prog_stats } let complete_dom_decls (rov : rule_or_verif) ((doms, syms) : 'a doms * syms) : @@ -2363,6 +2396,32 @@ let convert_verifs (prog : program) : program = in { prog with prog_targets } +let add_verif_info (v : verif) (prog : program) : program = + let used_vars = Com.get_used_variables (Pos.unmark v.verif_expr) in + let prog_vars = + List.fold_left + (fun vars var -> + let vn = + match var with + | Mast.Normal var_name -> var_name + | Mast.Generic _ -> assert false + in + let var = StrMap.find vn vars in + let var = + match var.Com.Var.scope with + | Tgv tgv -> { var with scope = Tgv { tgv with in_verif = true } } + | _ -> var + in + StrMap.add vn var vars) + prog.prog_vars used_vars + in + { prog with prog_vars } + +let add_verif_info_all_vars (prog : program) : program = + IntMap.fold + (fun _ verif prog -> add_verif_info verif prog) + prog.prog_verifs prog + let eval_expr_verif (prog : program) (verif : verif) (expr : Mast.expression Pos.marked) : float option = let my_floor a = floor (a +. 0.000001) in @@ -2671,4 +2730,4 @@ let proceed (p : Mast.program) (main_target : string) : program = in prog |> complete_rdom_decls |> complete_vdom_decls |> convert_rules |> complete_rule_domains |> complete_chainings |> convert_verifs - |> complete_verif_calls |> complete_vars + |> add_verif_info_all_vars |> complete_verif_calls |> complete_vars diff --git a/src/mlang/m_ir/com.ml b/src/mlang/m_ir/com.ml index 3ac20e92a..49996371b 100644 --- a/src/mlang/m_ir/com.ml +++ b/src/mlang/m_ir/com.ml @@ -124,6 +124,7 @@ module Var = struct cat : CatVar.t; is_given_back : bool; typ : value_typ option; + in_verif : bool; } type scope = Tgv of tgv | Temp of int option | Ref | Arg | Res @@ -142,6 +143,8 @@ module Var = struct Errors.raise_error (Format.sprintf "%s is not a TGV variable" (Pos.unmark v.name)) + let tgv_opt v = match v.scope with Tgv s -> Some s | _ -> None + let name v = v.name let name_str v = Pos.unmark v.name @@ -175,7 +178,15 @@ module Var = struct let cat v = (tgv v).cat - let is_given_back v = (tgv v).is_given_back + let is_given_back v = + match tgv_opt v with Some s -> s.is_given_back | None -> false + + let is_base v = + match tgv_opt v with + | Some s when s.cat = Computed { is_base = true } -> true + | _ -> false + + let in_verif v = (tgv v).in_verif let loc_tgv v = match v.loc with @@ -214,12 +225,23 @@ module Var = struct let new_tgv ~(name : string Pos.marked) ~(is_table : int option) ~(is_given_back : bool) ~(alias : string Pos.marked option) ~(descr : string Pos.marked) ~(attrs : int Pos.marked StrMap.t) - ~(cat : CatVar.t) ~(typ : value_typ option) : t = + ~(cat : CatVar.t) ~(typ : value_typ option) ~(in_verif : bool) : t = { name; id = new_id (); loc = LocTgv (Pos.unmark name, init_loc cat); - scope = Tgv { is_table; alias; descr; attrs; cat; is_given_back; typ }; + scope = + Tgv + { + is_table; + alias; + descr; + attrs; + cat; + is_given_back; + typ; + in_verif : bool; + }; } let new_temp ~(name : string Pos.marked) ~(is_table : int option) @@ -411,6 +433,36 @@ type 'v expression = and 'v m_expression = 'v expression Pos.marked +let get_used_variables (e : 'v expression) : 'v list = + let rec get_used_variables_ (e : 'v expression) (acc : 'v list) = + match e with + | TestInSet (_, (e, _), _) | Unop (_, (e, _)) -> + let acc = get_used_variables_ e acc in + acc + | Comparison (_, (e1, _), (e2, _)) | Binop (_, (e1, _), (e2, _)) -> + let acc = get_used_variables_ e1 acc in + let acc = get_used_variables_ e2 acc in + acc + | Index ((var, _), (e, _)) -> + let acc = var :: acc in + let acc = get_used_variables_ e acc in + acc + | Conditional ((e1, _), (e2, _), e3) -> ( + let acc = get_used_variables_ e1 acc in + let acc = get_used_variables_ e2 acc in + match e3 with None -> acc | Some (e3, _) -> get_used_variables_ e3 acc) + | FuncCall (_, args) -> + List.fold_left + (fun acc (arg, _) -> get_used_variables_ arg acc) + acc args + | FuncCallLoop _ | Loop _ -> assert false + | Var var | Size (var, _) | Attribut ((var, _), _) -> var :: acc + | Literal _ | NbCategory _ | NbAnomalies | NbDiscordances | NbInformatives + | NbBloquantes -> + acc + in + get_used_variables_ e [] + module Error = struct type typ = Anomaly | Discordance | Information diff --git a/src/mlang/m_ir/com.mli b/src/mlang/m_ir/com.mli index 948fa9d39..0246352b3 100644 --- a/src/mlang/m_ir/com.mli +++ b/src/mlang/m_ir/com.mli @@ -64,6 +64,7 @@ module Var : sig cat : CatVar.t; is_given_back : bool; typ : value_typ option; + in_verif : bool; } type scope = Tgv of tgv | Temp of int option | Ref | Arg | Res @@ -101,6 +102,10 @@ module Var : sig val is_given_back : t -> bool + val is_base : t -> bool + + val in_verif : t -> bool + val loc_tgv : t -> loc_tgv val loc_int : t -> int @@ -124,6 +129,7 @@ module Var : sig attrs:int Pos.marked StrMap.t -> cat:CatVar.t -> typ:value_typ option -> + in_verif:bool -> t val new_temp : @@ -267,6 +273,8 @@ type 'v expression = and 'v m_expression = 'v expression Pos.marked +val get_used_variables : 'v expression -> 'v list + module Error : sig type typ = Anomaly | Discordance | Information diff --git a/src/mlang/m_ir/mir_collect.ml b/src/mlang/m_ir/mir_collect.ml new file mode 100644 index 000000000..6646fcfbf --- /dev/null +++ b/src/mlang/m_ir/mir_collect.ml @@ -0,0 +1,143 @@ +(*This program is free software: you can redistribute it and/or modify it under + the terms of the GNU General Public License as published by the Free Software + Foundation, either version 3 of the License, or (at your option) any later + version. + + This program is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. + + You should have received a copy of the GNU General Public License along with + this program. If not, see . *) + +module G = Graph.Persistent.Digraph.Concrete (struct + type t = Com.Var.t + + let compare = compare + + let hash _ = 0 + + let equal = ( = ) +end) + +let var_graph (targets : Mir.target_data Com.TargetMap.t) : G.t = + Com.TargetMap.fold + (fun _ t graph -> + let instrs = t.Mir.target_prog in + List.fold_left + (fun graph instr -> + match Pos.unmark instr with + | Com.Affectation f -> + let var, vl = + match Pos.unmark f with + | SingleFormula (var, _, e) -> + (var, Com.get_used_variables (Pos.unmark e)) + | MultipleFormulaes _ -> assert false + in + List.fold_left + (fun graph var_dep -> G.add_edge graph (Pos.unmark var) var_dep) + graph vl + | _ -> graph) + graph instrs) + targets G.empty + +module VertexMap = MapExt.Make (G.V) + +let warn_unused_vertices (g : G.t) = + let module GC_LIKE : sig + val parcours : G.t -> unit + end = struct + type color = White | Grey | Black + + let parcours (g : G.t) = + let all_vertices = G.fold_vertex (fun v l -> v :: l) g [] in + let root_vertices = + List.filter + (fun var -> + try + Com.Var.is_given_back var + || Com.Var.cat_var_loc var = Some Com.CatVar.LocInput + || Com.Var.in_verif var + with Errors.StructuredError _ -> true) + all_vertices + in + let vmap = VertexMap.empty in + let vmap = + G.fold_vertex (fun v map -> VertexMap.add v White map) g vmap + in + let vmap = + List.fold_right + (fun v map -> VertexMap.add v Grey map) + root_vertices vmap + in + let rec mark (g : G.t) (grey : G.vertex list) (vmap : color VertexMap.t) = + match grey with + | [] -> vmap + | v :: l -> + let succs = G.succ g v in + let succs = + List.filter (fun v -> VertexMap.find v vmap = White) succs + in + let vmap = + List.fold_right + (fun v map -> + if VertexMap.find v map = White then VertexMap.add v Grey map + else map) + succs vmap + in + let vmap = VertexMap.add v Black vmap in + mark g (succs @ l) vmap + in + let vmap = mark g root_vertices vmap in + let white_vertices, _black_vertices = + G.fold_vertex + (fun v (w, b) -> + let color = VertexMap.find v vmap in + match color with + | White -> (v :: w, b) + | Black -> (w, v :: b) + | Grey -> + (* shouldn't happen *) + failwith + (Format.sprintf "Neither black or white found on name %s" + (Pos.unmark v.Com.Var.name))) + g ([], []) + in + let module O = Graph.Oper.P (G) in + let m = O.mirror g in + let vars_in_degrees = VertexMap.empty in + let vars_in_degrees = + G.fold_vertex + (fun var dmap -> + let d = G.out_degree m var in + let past_degree = + match VertexMap.find_opt var dmap with + | Some deg -> deg + | None -> 0 + in + let d = max d past_degree in + VertexMap.add var d dmap) + m vars_in_degrees + in + (* we have to use the mirror graph because if we used in_degree the complexity would be awful *) + (* keeping track of the in_degrees makes it *slightly* easier to track which vertices will be the easiest to remove *) + let white_vertices = + List.fast_sort + (fun s1 s2 -> + compare + (VertexMap.find s1 vars_in_degrees) + (VertexMap.find s2 vars_in_degrees)) + white_vertices + in + List.iter + (fun v -> + Cli.warning_print + "Variable %s isn't useful to compute any given back variable or \ + verification" + (Pos.unmark v.Com.Var.name)) + white_vertices + end in + GC_LIKE.parcours g + +let warn_unused_variables (targets : Mir.target_data Com.TargetMap.t) : unit = + targets |> var_graph |> warn_unused_vertices diff --git a/src/mlang/m_ir/mir_collect.mli b/src/mlang/m_ir/mir_collect.mli new file mode 100644 index 000000000..35fb8e778 --- /dev/null +++ b/src/mlang/m_ir/mir_collect.mli @@ -0,0 +1,13 @@ +(*This program is free software: you can redistribute it and/or modify it under + the terms of the GNU General Public License as published by the Free Software + Foundation, either version 3 of the License, or (at your option) any later + version. + + This program is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. + + You should have received a copy of the GNU General Public License along with + this program. If not, see . *) + +val warn_unused_variables : Mir.target_data Com.TargetMap.t -> unit diff --git a/src/mlang/m_ir/mir_interpreter.ml b/src/mlang/m_ir/mir_interpreter.ml index bb0dd080e..c034ac288 100644 --- a/src/mlang/m_ir/mir_interpreter.ml +++ b/src/mlang/m_ir/mir_interpreter.ml @@ -162,11 +162,11 @@ struct let update_ctx_with_inputs (ctx : ctx) (inputs : Com.literal Com.Var.Map.t) : unit = let value_inputs = - Com.Var.Map.mapi - (fun v l -> + Com.Var.Map.map + (fun l -> match l with | Com.Undefined -> Undefined - | Com.Float f -> Number (N.of_float_input v f)) + | Com.Float f -> Number (N.of_float_input f)) inputs in Com.Var.Map.iter diff --git a/src/mlang/m_ir/mir_number.ml b/src/mlang/m_ir/mir_number.ml index 5a3342699..20d6542ef 100644 --- a/src/mlang/m_ir/mir_number.ml +++ b/src/mlang/m_ir/mir_number.ml @@ -34,7 +34,7 @@ module type NumberInterface = sig val of_float : float -> t - val of_float_input : Com.Var.t -> float -> t + val of_float_input : float -> t val to_float : t -> float (** Warning: lossy *) @@ -101,7 +101,7 @@ module RegularFloatNumber : NumberInterface = struct let of_float f = f - let of_float_input _ f = f + let of_float_input f = f let to_float f = f @@ -172,7 +172,7 @@ module MPFRNumber : NumberInterface = struct let of_float f = Mpfrf.of_float f rounding - let of_float_input _ f = Mpfrf.of_float f rounding + let of_float_input f = Mpfrf.of_float f rounding let to_float f = Mpfrf.to_float ~round:rounding f @@ -237,7 +237,7 @@ module IntervalNumber : NumberInterface = struct let of_float (f : float) = v (Mpfrf.of_float f Down) (Mpfrf.of_float f Up) - let of_float_input (_v : Com.Var.t) (f : float) = + let of_float_input (f : float) = v (Mpfrf.of_float f Down) (Mpfrf.of_float f Up) let to_float (f : t) : float = @@ -348,7 +348,7 @@ module RationalNumber : NumberInterface = struct let of_float f = Mpqf.of_float f - let of_float_input _ f = Mpqf.of_float f + let of_float_input f = Mpqf.of_float f let to_float f = Mpqf.to_float f @@ -438,7 +438,7 @@ end) : NumberInterface = struct (Mpzf.of_float frac_part_scaled) (Mpzf.mul (Mpzf.of_float int_part) (precision_modulo ())) - let of_float_input _ (f : float) : t = of_float f + let of_float_input (f : float) : t = of_float f let to_float f = let frac_part, int_part = modf f in diff --git a/src/mlang/m_ir/mir_number.mli b/src/mlang/m_ir/mir_number.mli index 6932d3e58..fc64bcb26 100644 --- a/src/mlang/m_ir/mir_number.mli +++ b/src/mlang/m_ir/mir_number.mli @@ -33,7 +33,7 @@ module type NumberInterface = sig val of_float : float -> t - val of_float_input : Com.Var.t -> float -> t + val of_float_input : float -> t val to_float : t -> float diff --git a/tests/dummy.irj b/tests/dummy.irj new file mode 100644 index 000000000..68f850c7d --- /dev/null +++ b/tests/dummy.irj @@ -0,0 +1,10 @@ +#NOM +DUMMY +#ENTREES-PRIMITIF +#CONTROLES-PRIMITIF +#RESULTATS-PRIMITIF +#ENTREES-CORRECTIF +#CONTROLES-CORRECTIF +#RESULTATS-CORRECTIF +## +