From 40da5a39ae279f2aca3450662929c7974d22e45b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?No=C3=A9=20Ensarguet?= Date: Wed, 18 Dec 2024 11:19:45 +0100 Subject: [PATCH 01/10] remove superfluous argument to Mir_number.of_float_input --- src/mlang/m_ir/mir_interpreter.ml | 6 +++--- src/mlang/m_ir/mir_number.ml | 12 ++++++------ src/mlang/m_ir/mir_number.mli | 2 +- 3 files changed, 10 insertions(+), 10 deletions(-) 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 From 762fb4799a2586764925755417769ae475ecb961 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?No=C3=A9=20Ensarguet?= Date: Mon, 7 Apr 2025 18:13:19 +0200 Subject: [PATCH 02/10] create get_used_variables --- src/mlang/m_ir/com.ml | 30 ++++++++++++++++++++++++++++++ src/mlang/m_ir/com.mli | 2 ++ 2 files changed, 32 insertions(+) diff --git a/src/mlang/m_ir/com.ml b/src/mlang/m_ir/com.ml index 3ac20e92a..5fd069c8c 100644 --- a/src/mlang/m_ir/com.ml +++ b/src/mlang/m_ir/com.ml @@ -411,6 +411,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..c54fcd865 100644 --- a/src/mlang/m_ir/com.mli +++ b/src/mlang/m_ir/com.mli @@ -267,6 +267,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 From abf91c8d7da3975c8054ec5e5e166baee4134b04 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?No=C3=A9=20Ensarguet?= Date: Thu, 27 Feb 2025 10:58:08 +0100 Subject: [PATCH 03/10] Add verif info to variables --- src/mlang/m_frontend/check_validity.ml | 30 +++++++++++++++++++++++++- src/mlang/m_ir/com.ml | 18 ++++++++++++++-- src/mlang/m_ir/com.mli | 4 ++++ 3 files changed, 49 insertions(+), 3 deletions(-) diff --git a/src/mlang/m_frontend/check_validity.ml b/src/mlang/m_frontend/check_validity.ml index f6dcf7cdc..32f15af4a 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 @@ -2363,6 +2365,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 +2699,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 5fd069c8c..ceb8b7986 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 @@ -177,6 +178,8 @@ module Var = struct let is_given_back v = (tgv v).is_given_back + let in_verif v = (tgv v).in_verif + let loc_tgv v = match v.loc with | LocTgv (_, l) -> l @@ -214,12 +217,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) diff --git a/src/mlang/m_ir/com.mli b/src/mlang/m_ir/com.mli index c54fcd865..fb867260c 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,8 @@ module Var : sig val is_given_back : t -> bool + val in_verif : t -> bool + val loc_tgv : t -> loc_tgv val loc_int : t -> int @@ -124,6 +127,7 @@ module Var : sig attrs:int Pos.marked StrMap.t -> cat:CatVar.t -> typ:value_typ option -> + in_verif:bool -> t val new_temp : From fbe6be61a409c1e1b0c28e86ead6350fd7805301 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?No=C3=A9=20Ensarguet?= Date: Thu, 27 Feb 2025 11:05:31 +0100 Subject: [PATCH 04/10] First iteration to collect unused variables --- src/mlang/driver.ml | 1 + src/mlang/dune | 2 +- src/mlang/m_ir/com.ml | 10 +- src/mlang/m_ir/com.mli | 2 + src/mlang/m_ir/mir_collect.ml | 176 +++++++++++++++++++++++++++++++++ src/mlang/m_ir/mir_collect.mli | 13 +++ 6 files changed, 202 insertions(+), 2 deletions(-) create mode 100644 src/mlang/m_ir/mir_collect.ml create mode 100644 src/mlang/m_ir/mir_collect.mli diff --git a/src/mlang/driver.ml b/src/mlang/driver.ml index c3ea6a278..3f6961533 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.var_graph_act 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_ir/com.ml b/src/mlang/m_ir/com.ml index ceb8b7986..49996371b 100644 --- a/src/mlang/m_ir/com.ml +++ b/src/mlang/m_ir/com.ml @@ -143,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 @@ -176,7 +178,13 @@ 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 diff --git a/src/mlang/m_ir/com.mli b/src/mlang/m_ir/com.mli index fb867260c..0246352b3 100644 --- a/src/mlang/m_ir/com.mli +++ b/src/mlang/m_ir/com.mli @@ -102,6 +102,8 @@ 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 diff --git a/src/mlang/m_ir/mir_collect.ml b/src/mlang/m_ir/mir_collect.ml new file mode 100644 index 000000000..51d04b30f --- /dev/null +++ b/src/mlang/m_ir/mir_collect.ml @@ -0,0 +1,176 @@ +(*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 _ -> failwith "multiple formulae ?" + 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) + +type color = White | Grey | Black + +let remove_unused_vertices (g : G.t) = + let module GC_LIKE : sig + val parcours : G.t -> color VertexMap.t + 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 + (* || Com.Var.is_base var *) + with Errors.StructuredError _ -> true) + all_vertices + in + (* let module VertexMap = Map.Make (G.V) 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 + if color = White then (v :: w, b) + else if color = Black then (w, v :: b) + else + (* a bit verbose but this is just to make sure, should never happen anyways *) + failwith + (Format.sprintf "Neither black or white found on name %s" + (Pos.unmark v.Com.Var.name))) + g ([], []) + in + let name_map = StrMap.empty in + let name_map = + G.fold_vertex + (fun var nmap -> + let vname = Pos.unmark var.Com.Var.name in + let color = try StrMap.find vname nmap with Not_found -> White in + if color <> Black then + StrMap.add vname (VertexMap.find var vmap) nmap + else nmap) + g name_map + in + let module O = Graph.Oper.P (G) in + let m = O.mirror g in + let names_in_degrees = StrMap.empty in + let names_in_degrees = + G.fold_vertex + (fun var dmap -> + let vname = Pos.unmark var.Com.Var.name in + let d = G.out_degree m var in + let past_degree = + match StrMap.find_opt vname dmap with + | Some deg -> deg + | None -> d + in + let d = max d past_degree in + StrMap.add vname d dmap) + m names_in_degrees + in + (* Format.printf "V_FORVA degree : %d@." + (StrMap.find "V_FORVA" names_in_degrees); *) + (* we have to use the mirror because if we used in_degree the complexity would be awful *) + let white_names, black_names = + StrMap.fold + (fun s color (w, b) -> + if color = White then (s :: w, b) + else if color = Black then (w, s :: b) + else failwith "Not black and white found") + name_map ([], []) + in + let white_names = + List.fast_sort + (fun s1 s2 -> + compare + (StrMap.find s1 names_in_degrees) + (StrMap.find s2 names_in_degrees)) + white_names + in + (* List.iter (fun s -> Format.printf "%s@." s) white_names; *) + List.iter + (fun name -> + Cli.warning_print "Unused variable : %s - in_degree %d" name + (StrMap.find name names_in_degrees)) + white_names; + Format.printf "vertices -- all: %d, white : %d, black : %d@." + (G.nb_vertex g) + (List.length white_vertices) + (List.length black_vertices); + Format.printf "names -- all: %d, white : %d, black : %d@." + (StrMap.cardinal name_map) (List.length white_names) + (List.length black_names); + vmap + end in + let vmap = GC_LIKE.parcours g in + vmap + +let var_graph_act (targets : Mir.target_data Com.TargetMap.t) : unit = + let g = var_graph targets in + ignore (remove_unused_vertices g) diff --git a/src/mlang/m_ir/mir_collect.mli b/src/mlang/m_ir/mir_collect.mli new file mode 100644 index 000000000..4b972c93b --- /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 var_graph_act : Mir.target_data Com.TargetMap.t -> unit From 7c8265b78d116887ef079cbf1077f87d412e401b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?No=C3=A9=20Ensarguet?= Date: Mon, 3 Mar 2025 17:44:12 +0100 Subject: [PATCH 05/10] scripts to remove unused variables --- remove_unused_variables.sh | 33 +++++++++++++++++++++++++++++++++ tests/dummy.irj | 10 ++++++++++ 2 files changed, 43 insertions(+) create mode 100755 remove_unused_variables.sh create mode 100644 tests/dummy.irj diff --git a/remove_unused_variables.sh b/remove_unused_variables.sh new file mode 100755 index 000000000..5c0a8970c --- /dev/null +++ b/remove_unused_variables.sh @@ -0,0 +1,33 @@ +#!/bin/bash + +set -ue + +if [ -z "$1" ] || [ -z "$2" ]; then + echo "Usage: $0 " + exit 1 +fi + +var_file="$1" +code_base="$2" + +if [ ! -f "$var_file" ]; then + echo "The file $1 does not exist" + exit 2 +fi + +counter=0 + +while IFS= read -r var; do + if [ -z "$var" ]; then + continue + fi + + echo "Processing variable $var" + + grep -lE "(^|[^(A-Z|a-z|0-9|_)])$var([^(A-Z|a-z|0-9|_)]|$)" "$code_base"/*.m | xargs sed -ibak -E "/(^|[^(A-Z|a-z|0-9|_)])$var([^(A-Z|a-z|0-9|_)]|$)/d" +# 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++)) && echo $counter +done < "$var_file" + +echo "Done" 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 +## + From 9f96f1677f4c867aab8f81547df151ac8b9b925f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?No=C3=A9=20Ensarguet?= Date: Fri, 28 Mar 2025 15:43:13 +0100 Subject: [PATCH 06/10] Better script --- remove_unused_variables.sh | 19 +++++++++++++++---- 1 file changed, 15 insertions(+), 4 deletions(-) diff --git a/remove_unused_variables.sh b/remove_unused_variables.sh index 5c0a8970c..c8dddd991 100755 --- a/remove_unused_variables.sh +++ b/remove_unused_variables.sh @@ -2,18 +2,24 @@ set -ue -if [ -z "$1" ] || [ -z "$2" ]; then - echo "Usage: $0 " +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 $1 does not exist" + 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 @@ -24,10 +30,15 @@ while IFS= read -r var; do echo "Processing variable $var" - grep -lE "(^|[^(A-Z|a-z|0-9|_)])$var([^(A-Z|a-z|0-9|_)]|$)" "$code_base"/*.m | xargs sed -ibak -E "/(^|[^(A-Z|a-z|0-9|_)])$var([^(A-Z|a-z|0-9|_)]|$)/d" + 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++)) && echo $counter + echo "delete from dico_24 where variable='$var';" >> "$sql_file" done < "$var_file" echo "Done" From d84b2c6db88064cade0028b2f56afc5f7fc16370 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?No=C3=A9=20Ensarguet?= Date: Thu, 10 Apr 2025 17:27:18 +0200 Subject: [PATCH 07/10] script remove bashisms --- remove_unused_variables.sh | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/remove_unused_variables.sh b/remove_unused_variables.sh index c8dddd991..36c9f8c83 100755 --- a/remove_unused_variables.sh +++ b/remove_unused_variables.sh @@ -1,4 +1,4 @@ -#!/bin/bash +#!/bin/sh set -ue @@ -37,7 +37,7 @@ while IFS= read -r var; do # 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++)) && echo $counter + counter=$((counter + 1)) && echo $counter echo "delete from dico_24 where variable='$var';" >> "$sql_file" done < "$var_file" From 25dc8a568e6c19c42a6b65c7e2ed5e89067a42ea Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?No=C3=A9=20Ensarguet?= Date: Thu, 27 Mar 2025 11:17:45 +0100 Subject: [PATCH 08/10] Warn on undefined computed variables --- src/mlang/m_frontend/check_validity.ml | 34 ++++++++++++++++++++++++++ 1 file changed, 34 insertions(+) diff --git a/src/mlang/m_frontend/check_validity.ml b/src/mlang/m_frontend/check_validity.ml index 32f15af4a..73ec1c3be 100644 --- a/src/mlang/m_frontend/check_validity.ml +++ b/src/mlang/m_frontend/check_validity.ml @@ -830,6 +830,39 @@ 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 + Errors.print_spanned_warning + (Format.asprintf + "Variable %s is declared as computed but never defined" + var_name) + (Pos.get_position var.Com.Var.name) + | Input _ -> ()) + vars + let complete_vars (prog : program) : program = let prog_vars = prog.prog_vars in let prog_vars = @@ -1060,6 +1093,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) : From 3c406bc3ae4d166f1aedfac2c8138cc10b24e668 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?No=C3=A9=20Ensarguet?= Date: Mon, 14 Apr 2025 17:47:38 +0200 Subject: [PATCH 09/10] Cleanup unused variables --- src/mlang/driver.ml | 2 +- src/mlang/m_ir/mir_collect.ml | 101 +++++++++++---------------------- src/mlang/m_ir/mir_collect.mli | 2 +- 3 files changed, 36 insertions(+), 69 deletions(-) diff --git a/src/mlang/driver.ml b/src/mlang/driver.ml index 3f6961533..418b5dcd7 100644 --- a/src/mlang/driver.ml +++ b/src/mlang/driver.ml @@ -197,7 +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.var_graph_act m_program.program_targets; + 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/m_ir/mir_collect.ml b/src/mlang/m_ir/mir_collect.ml index 51d04b30f..6646fcfbf 100644 --- a/src/mlang/m_ir/mir_collect.ml +++ b/src/mlang/m_ir/mir_collect.ml @@ -32,7 +32,7 @@ let var_graph (targets : Mir.target_data Com.TargetMap.t) : G.t = match Pos.unmark f with | SingleFormula (var, _, e) -> (var, Com.get_used_variables (Pos.unmark e)) - | MultipleFormulaes _ -> failwith "multiple formulae ?" + | MultipleFormulaes _ -> assert false in List.fold_left (fun graph var_dep -> G.add_edge graph (Pos.unmark var) var_dep) @@ -43,13 +43,11 @@ let var_graph (targets : Mir.target_data Com.TargetMap.t) : G.t = module VertexMap = MapExt.Make (G.V) -type color = White | Grey | Black - -let remove_unused_vertices (g : G.t) = +let warn_unused_vertices (g : G.t) = let module GC_LIKE : sig - val parcours : G.t -> color VertexMap.t + val parcours : G.t -> unit end = struct - (* type color = White | Grey | Black *) + type color = White | Grey | Black let parcours (g : G.t) = let all_vertices = G.fold_vertex (fun v l -> v :: l) g [] in @@ -60,11 +58,9 @@ let remove_unused_vertices (g : G.t) = Com.Var.is_given_back var || Com.Var.cat_var_loc var = Some Com.CatVar.LocInput || Com.Var.in_verif var - (* || Com.Var.is_base var *) with Errors.StructuredError _ -> true) all_vertices in - (* let module VertexMap = Map.Make (G.V) in *) let vmap = VertexMap.empty in let vmap = G.fold_vertex (fun v map -> VertexMap.add v White map) g vmap @@ -93,84 +89,55 @@ let remove_unused_vertices (g : G.t) = mark g (succs @ l) vmap in let vmap = mark g root_vertices vmap in - let white_vertices, black_vertices = + let white_vertices, _black_vertices = G.fold_vertex (fun v (w, b) -> let color = VertexMap.find v vmap in - if color = White then (v :: w, b) - else if color = Black then (w, v :: b) - else - (* a bit verbose but this is just to make sure, should never happen anyways *) - failwith - (Format.sprintf "Neither black or white found on name %s" - (Pos.unmark v.Com.Var.name))) + 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 name_map = StrMap.empty in - let name_map = - G.fold_vertex - (fun var nmap -> - let vname = Pos.unmark var.Com.Var.name in - let color = try StrMap.find vname nmap with Not_found -> White in - if color <> Black then - StrMap.add vname (VertexMap.find var vmap) nmap - else nmap) - g name_map - in let module O = Graph.Oper.P (G) in let m = O.mirror g in - let names_in_degrees = StrMap.empty in - let names_in_degrees = + let vars_in_degrees = VertexMap.empty in + let vars_in_degrees = G.fold_vertex (fun var dmap -> - let vname = Pos.unmark var.Com.Var.name in let d = G.out_degree m var in let past_degree = - match StrMap.find_opt vname dmap with + match VertexMap.find_opt var dmap with | Some deg -> deg - | None -> d + | None -> 0 in let d = max d past_degree in - StrMap.add vname d dmap) - m names_in_degrees - in - (* Format.printf "V_FORVA degree : %d@." - (StrMap.find "V_FORVA" names_in_degrees); *) - (* we have to use the mirror because if we used in_degree the complexity would be awful *) - let white_names, black_names = - StrMap.fold - (fun s color (w, b) -> - if color = White then (s :: w, b) - else if color = Black then (w, s :: b) - else failwith "Not black and white found") - name_map ([], []) + VertexMap.add var d dmap) + m vars_in_degrees in - let white_names = + (* 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 - (StrMap.find s1 names_in_degrees) - (StrMap.find s2 names_in_degrees)) - white_names + (VertexMap.find s1 vars_in_degrees) + (VertexMap.find s2 vars_in_degrees)) + white_vertices in - (* List.iter (fun s -> Format.printf "%s@." s) white_names; *) List.iter - (fun name -> - Cli.warning_print "Unused variable : %s - in_degree %d" name - (StrMap.find name names_in_degrees)) - white_names; - Format.printf "vertices -- all: %d, white : %d, black : %d@." - (G.nb_vertex g) - (List.length white_vertices) - (List.length black_vertices); - Format.printf "names -- all: %d, white : %d, black : %d@." - (StrMap.cardinal name_map) (List.length white_names) - (List.length black_names); - vmap + (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 - let vmap = GC_LIKE.parcours g in - vmap + GC_LIKE.parcours g -let var_graph_act (targets : Mir.target_data Com.TargetMap.t) : unit = - let g = var_graph targets in - ignore (remove_unused_vertices 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 index 4b972c93b..35fb8e778 100644 --- a/src/mlang/m_ir/mir_collect.mli +++ b/src/mlang/m_ir/mir_collect.mli @@ -10,4 +10,4 @@ You should have received a copy of the GNU General Public License along with this program. If not, see . *) -val var_graph_act : Mir.target_data Com.TargetMap.t -> unit +val warn_unused_variables : Mir.target_data Com.TargetMap.t -> unit From cfe245491d83418b5a1613a8a520b38cbf95ea9f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?No=C3=A9=20Ensarguet?= Date: Mon, 14 Apr 2025 18:14:26 +0200 Subject: [PATCH 10/10] Simplify undef declared vars --- src/mlang/m_frontend/check_validity.ml | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/src/mlang/m_frontend/check_validity.ml b/src/mlang/m_frontend/check_validity.ml index 73ec1c3be..e382432d7 100644 --- a/src/mlang/m_frontend/check_validity.ml +++ b/src/mlang/m_frontend/check_validity.ml @@ -855,11 +855,8 @@ let warn_on_undef_computed_vars (rules : rule IntMap.t) match Com.Var.cat var with | Computed _ -> if not (StrSet.mem var_name def_vars) then - Errors.print_spanned_warning - (Format.asprintf - "Variable %s is declared as computed but never defined" - var_name) - (Pos.get_position var.Com.Var.name) + Cli.warning_print + "Variable %s is declared as computed but never defined" var_name | Input _ -> ()) vars