clearer resolution of variables + add warning (#605)

(cherry picked from commit b60a11e)

CHANGELOG.md

@@ -43,6 +43,13 @@
 - Expansion of `#copy` operators uses an intermediate register when needed
   ([PR #735](https://github.com/jasmin-lang/jasmin/pull/735)).
 
+- Add more warning options:
+    - `-wduplicatevar`: warns when two variables share the same name;
+    - `-wunusedvar`: warns when a declared variable is not used.
+
+  ([PR #605](https://github.com/jasmin-lang/jasmin/pull/605)).
+  Warning this is a **breaking change**.
+
 # Jasmin 2023.06.2 — 2023-12-22
 
 ## New features

compiler/src/glob_options.ml

@@ -190,6 +190,8 @@ let options = [
     "-w_"  , Arg.Unit (add_warning IntroduceNone), ": print warning when extra _ is introduced";
     "-wea", Arg.Unit (add_warning ExtraAssignment), ": print warning when extra assignment is introduced";
     "-winsertarraycopy", Arg.Unit (add_warning IntroduceArrayCopy), ": print warning when array copy is introduced";
+    "-wduplicatevar", Arg.Unit (add_warning DuplicateVar), ": print warning when two variables share the same name";
+    "-wunusedvar", Arg.Unit (add_warning UnusedVar), ": print warning when a variable is not used";
     "-noinsertarraycopy", Arg.Clear introduce_array_copy, ": do not automatically insert array copy";
     "-nowarning", Arg.Unit (nowarning), ": do no print warning";
     "-color", Arg.Symbol (["auto"; "always"; "never"], set_color), ": print messages with color";

compiler/src/pretyping.ml

@@ -237,14 +237,15 @@ module Env : sig
   val get_known_implicits : 'asm env -> (string * string) list 
 
   module Vars : sig
-    val push       : 'asm env -> P.pvar -> 'asm env
-    val push_param : 'asm env -> (P.pvar * P.pexpr) -> 'asm env
-    val find       : A.symbol -> 'asm env -> P.pvar option
-  end
+    val push_global   : 'asm env -> (P.pvar * P.pexpr P.ggexpr) -> 'asm env
+    val push_param    : 'asm env -> (P.pvar * P.pexpr) -> 'asm env
+    val push_local    : 'asm env -> P.pvar -> 'asm env
+    val push_implicit : 'asm env -> P.pvar -> 'asm env
+
+    val find : A.symbol -> 'asm env -> (P.pvar * E.v_scope) option
 
-  module Globals : sig
-    val push : 'asm env -> (P.pvar * P.pexpr P.ggexpr) -> 'asm env
-    val find : A.symbol -> 'asm env -> P.pvar option
+    val iter_locals  : (P.pvar -> unit) -> 'asm env -> unit
+    val clear_locals : 'asm env -> 'asm env
   end
 
   module Funs : sig
@@ -257,7 +258,8 @@ module Env : sig
     val get  : 'asm env -> (P.funname * (Z.t * Z.t) list) L.located list
   end
 
-end = struct
+end  = struct
+
   type loader = 
     { loaded : Path.t list (* absolute path *)
     ; idir   : Path.t      (* absolute initial path *)
@@ -266,14 +268,15 @@ end = struct
     } 
 
   type 'asm env = {
-    e_vars    : (A.symbol, P.pvar) Map.t;
-    e_globals : (A.symbol, P.pvar) Map.t;
+    e_vars    : (A.symbol, P.pvar * E.v_scope) Map.t;
     e_funs    : (A.symbol, (unit, 'asm) P.pfunc * P.pty list) Map.t;
     e_decls   : (unit, 'asm) P.pmod_item list;
     e_exec    : (P.funname * (Z.t * Z.t) list) L.located list;
     e_loader  : loader;
-    e_reserved : Ss.t;                           (* Set of string (variable name) declared by the user, 
-                                                    fresh variables introduced by the compiler should be disjoint from this set *) 
+    e_declared : P.Spv.t ref; (* Set of local variables declared somewhere in the function *)
+    e_reserved : Ss.t;     (* Set of string (variable name) declared by the user, 
+                              fresh variables introduced by the compiler 
+                              should be disjoint from this set *) 
     e_known_implicits : (string * string) list;  (* Association list for implicit flags *)
   }
 
@@ -286,11 +289,11 @@ end = struct
 
   let empty : 'asm env =
     { e_vars    = Map.empty
-    ; e_globals = Map.empty 
     ; e_funs    = Map.empty
     ; e_decls   = []
     ; e_exec    = []
     ; e_loader  = empty_loader
+    ; e_declared = ref P.Spv.empty
     ; e_reserved = Ss.empty
     ; e_known_implicits = [];
     }
@@ -299,12 +302,11 @@ end = struct
     { env with e_reserved = Ss.add s env.e_reserved }
 
   let is_reserved env s = 
-    Ss.mem s env.e_reserved 
+    Ss.mem s env.e_reserved
 
   let set_known_implicits env known_implicits = { env with e_known_implicits = known_implicits }
   let get_known_implicits env = env.e_known_implicits
 
-
   let add_from env (name, filename) = 
     let p = Path.of_string filename in 
     let ap = 
@@ -358,30 +360,51 @@ end = struct
   let decls env = env.e_decls 
 
   let dependencies env = env.e_loader.loaded
+
+  (* Local variables *)
 
   module Vars = struct
-    let push (env : 'asm env) (v : P.pvar) =
-      { env with e_vars = Map.add v.P.v_name v env.e_vars;
-                 e_reserved = Ss.add v.P.v_name env.e_reserved}
 
+    let find (x : A.symbol) (env : 'asm env) = 
+      Map.Exceptionless.find x env.e_vars
+
+    let warn_double_decl v map = 
+      try 
+        let v', _ = Map.find v.P.v_name map in
+        warning DuplicateVar (L.i_loc0 v.v_dloc) 
+          "the variable %s is already declare at %a"
+          v.v_name L.pp_loc v'.P.v_dloc 
+      with Not_found -> ()
+
+    let push_core (env : 'asm env) (v : P.pvar) (s : E.v_scope) = 
+      warn_double_decl v env.e_vars; 
+      { env with e_vars = Map.add v.P.v_name (v, s) env.e_vars;
+                 e_reserved = Ss.add v.P.v_name env.e_reserved;
+      }
+
+    let push_global env (x, _ as d) = 
+      let env = push_core env x Sglob in
+      { env with e_decls = P.MIglobal d :: env.e_decls }
+
     let push_param env (x,_ as d) = 
-      let env = push env x in
-      { env with e_decls = P.MIparam d :: env.e_decls }
+      let env = push_core env x Slocal in
+      { env with e_decls = P.MIparam d :: env.e_decls } 
+
+    let push_local (env : 'asm env) (v : P.pvar) =
+      env.e_declared := P.Spv.add v !(env.e_declared);
+      push_core env v Slocal
 
-    let find (x : A.symbol) (env : 'asm env) =
-      Map.Exceptionless.find x env.e_vars
-  end
+    let push_implicit (env : 'asm env) (v : P.pvar) =
+      assert (not (Map.mem v.P.v_name env.e_vars));
+      push_core env v Slocal
 
-  module Globals = struct
+
+    let iter_locals f (env : 'asm env) = 
+      P.Spv.iter f !(env.e_declared)
 
-    let push env (v,_ as d) = 
-      { env with e_globals = Map.add v.P.v_name v env.e_globals;
-                 e_decls = P.MIglobal d :: env.e_decls;
-                 e_reserved = Ss.add v.P.v_name env.e_reserved
-      }
+    let clear_locals (env : 'asm env) = 
+      { env with e_declared = ref P.Spv.empty } 
 
-    let find (x : A.symbol) (env : 'asm env) =
-      Map.Exceptionless.find x env.e_globals
   end
 
   module Funs = struct
@@ -581,32 +604,33 @@ type tt_mode = [
   ]
 
 (* -------------------------------------------------------------------- *)
-let tt_var (mode:tt_mode) (env : 'asm Env.env) { L.pl_desc = x; L.pl_loc = lc; } =
-  let v =
+
+let tt_var_core (mode:tt_mode) (env : 'asm Env.env) { L.pl_desc = x; L.pl_loc = lc; } = 
+  let v, _ as vs =
     match Env.Vars.find x env with
-    | Some v -> v
+    | Some vs -> vs
     | None -> rs_tyerror ~loc:lc (UnknownVar x) in
   begin match mode with
   | `OnlyParam ->
     if v.P.v_kind <> W.Const then
-      rs_tyerror ~loc:lc (StringError "only param variable are allowed here")
+      rs_tyerror ~loc:lc (StringError "only param variables are allowed here")
   | `NoParam -> 
     if v.P.v_kind = W.Const then
-      rs_tyerror ~loc:lc (StringError "param variable not allowed here")
+      rs_tyerror ~loc:lc (StringError "param variables are not allowed here")
   | `AllVar -> ()
   end;
+  vs
+
+let tt_var (mode:tt_mode) (env : 'asm Env.env) x = 
+  let v, s = tt_var_core mode env x in
+  if s = Sglob then 
+    rs_tyerror ~loc:(L.loc x) (StringError "global variables are not allowed here");
   v
 
 let tt_var_global (mode:tt_mode) (env : 'asm Env.env) v = 
   let lc = v.L.pl_loc in
-  let x, k = 
-    try tt_var mode env v, E.Slocal
-    with TyError _ when mode <> `OnlyParam ->
-      let x = v.L.pl_desc in
-      match Env.Globals.find x env with
-      | Some v -> v, E.Sglob
-      | None -> rs_tyerror ~loc:lc (UnknownVar x) in
-  { P.gv = L.mk_loc lc x; P.gs = k }, x.P.v_ty
+  let x, s = tt_var_core mode env v in
+  { P.gv = L.mk_loc lc x; P.gs = s }, x.P.v_ty
 
 (* -------------------------------------------------------------------- *)
 let tt_fun (env : 'asm Env.env) { L.pl_desc = x; L.pl_loc = loc; } =
@@ -1237,7 +1261,7 @@ let tt_vardecl dfl_writable pd (env : 'asm Env.env) ((annot, (sto, xty)), x) =
 let tt_vardecls_push dfl_writable pd (env : 'asm Env.env) pxs =
   let xs  = List.map (tt_vardecl dfl_writable pd env) pxs in
   let env = 
-    List.fold_left (fun env x -> Env.Vars.push env (L.unloc x)) env xs in
+    List.fold_left (fun env x -> Env.Vars.push_local env (L.unloc x)) env xs in
   (env, xs)
 
 (* -------------------------------------------------------------------- *)
@@ -1998,12 +2022,22 @@ let add_known_implicits arch_info env c =
   let env, known_implicits = 
     List.map_fold (fun env (s1, s2) ->
         let s2 = create env s2 in
-        let env = Env.Vars.push env (P.PV.mk s2 (Reg(Normal, Direct)) P.tbool L._dummy []) in
+        let env = Env.Vars.push_implicit env (P.PV.mk s2 (Reg(Normal, Direct)) P.tbool L._dummy []) in
         env, (s1, s2)) env arch_info.known_implicits in
-  Env.set_known_implicits env known_implicits 
+  Env.set_known_implicits env known_implicits
 
 
-let tt_fundef arch_info (env : 'asm Env.env) loc (pf : S.pfundef) : 'asm Env.env =
+let warn_unused_variables env f = 
+  let used = List.fold_left (fun s v -> P.Spv.add (L.unloc v) s) P.Spv.empty f.P.f_ret in
+  let used = P.Spv.union used (P.pvars_c f.P.f_body) in
+  let pp_var fmt x = F.fprintf fmt "%s.%s" x.P.v_name (CoreIdent.string_of_uid x.P.v_id) in
+  Env.Vars.iter_locals (fun x -> 
+   if not (P.Spv.mem x used) then 
+     warning UnusedVar (L.i_loc0 x.v_dloc) "unused variable %a" pp_var x)
+    env
+
+let tt_fundef arch_info (env0 : 'asm Env.env) loc (pf : S.pfundef) : 'asm Env.env =
+  let env = Env.Vars.clear_locals env0 in
   if is_combine_flags pf.pdf_name then
     rs_tyerror ~loc:(L.loc pf.pdf_name) (string_error "invalid function name");
   let inret = Option.map_default (List.map L.unloc) [] pf.pdf_body.pdb_ret in
@@ -2032,8 +2066,10 @@ let tt_fundef arch_info (env : 'asm Env.env) loc (pf : S.pfundef) : 'asm Env.env
 
   check_return_statement ~loc fdef.P.f_name rty
     (List.map (fun x -> (L.loc x, (L.unloc x).P.v_ty)) xret);
+
+  warn_unused_variables envb fdef;
 
-  Env.Funs.push env fdef rty
+  Env.Funs.push env0 fdef rty
 
 (* -------------------------------------------------------------------- *)
 let tt_global_def pd env (gd:S.gpexpr) =
@@ -2079,7 +2115,7 @@ let tt_global pd (env : 'asm Env.env) _loc (gd: S.pglobal) : 'asm Env.env =
 
   let x = P.PV.mk (L.unloc gd.S.pgd_name) W.Global ty (L.loc gd.S.pgd_name) [] in
 
-  Env.Globals.push env (x,d)
+  Env.Vars.push_global env (x,d)
 
 (* -------------------------------------------------------------------- *)
 let rec tt_item arch_info (env : 'asm Env.env) pt : 'asm Env.env =

compiler/src/prog.ml

@@ -223,6 +223,7 @@ let ident_of_var (x:var) : CoreIdent.var = x
 
 (* -------------------------------------------------------------------- *)
 (* used variables                                                       *)
+
 let rvars_v f x s =
   if is_gkvar x then f (L.unloc x.gv) s
   else s 
@@ -269,6 +270,7 @@ let vars_e e = rvars_e Sv.add Sv.empty e
 let vars_es es = rvars_es Sv.add Sv.empty es
 let vars_i i = rvars_i Sv.add Sv.empty i
 let vars_c c = rvars_c Sv.add Sv.empty c
+let pvars_c c = rvars_c Spv.add Spv.empty c
 
 let params fc =
   List.fold_left (fun s v -> Sv.add v s) Sv.empty fc.f_args

compiler/src/prog.mli

@@ -200,6 +200,7 @@ val vars_e  : expr -> Sv.t
 val vars_es : expr list -> Sv.t
 val vars_i  : ('info,'asm) instr -> Sv.t
 val vars_c  : ('info,'asm) stmt  -> Sv.t
+val pvars_c  : ('info,'asm) pstmt  -> Spv.t
 val vars_fc : ('info,'asm) func  -> Sv.t
 
 val locals  : ('info,'asm) func -> Sv.t

compiler/src/toEC.ml

@@ -1014,7 +1014,7 @@ module Leak = struct
     let (_s,option) = Mv.find (L.unloc x) env.vars in
     if option then Initv (L.unloc x) :: safe
     else safe
-    
+
   let rec safe_e_rec pd env safe = function
     | Pconst _ | Pbool _ | Parr_init _ -> safe
     | Pvar x -> 

compiler/src/utils.ml

@@ -402,6 +402,8 @@ type warning =
   | IntroduceNone 
   | IntroduceArrayCopy
   | SimplifyVectorSuffix
+  | DuplicateVar 
+  | UnusedVar 
   | Deprecated
   | Experimental
   | Always

compiler/src/utils.mli

@@ -174,6 +174,8 @@ type warning =
   | IntroduceNone
   | IntroduceArrayCopy
   | SimplifyVectorSuffix
+  | DuplicateVar 
+  | UnusedVar 
   | Deprecated
   | Experimental
   | Always

compiler/tests/success/common/test_warn_var.jazz

@@ -0,0 +1,29 @@
+
+param int r = 0;
+u32 r = 0;
+
+
+export fn fok (reg u32 r) -> reg u32 {
+  reg u32 x;
+  x = r;
+  return x;
+}
+
+export fn f (reg u32 y) -> reg u32 {
+  reg u32 x;
+  x = y;
+  if (x == 0) {
+    reg u32 y;
+    y = x;
+    x = y;
+  }
+  return x;
+}
+
+
+export fn g (reg u32 z) -> reg u32 {
+  reg u32 x y;
+  x = z;
+  return x;
+}
+