fix warnings and enable them again

Author: zapashcanon

interpreter/binary/decode.ml

@@ -944,7 +944,7 @@ let code_section s =
 
 (* Element section *)
 
-let passive s =
+let passive _s =
   Passive
 
 let active s =
@@ -957,7 +957,7 @@ let active_zero s =
   let offset = const s in
   Active {index; offset}
 
-let declarative s =
+let declarative _s =
   Declarative
 
 let elem_index s =

interpreter/binary/utf8.ml

@@ -8,7 +8,7 @@ let con n = 0x80 lor (n land 0x3f)
 let rec encode ns = Lib.String.implode (List.map Char.chr (encode' ns))
 and encode' = function
   | [] -> []
-  | n::ns when n < 0 ->
+  | n::_ns when n < 0 ->
     raise Utf8
   | n::ns when n < 0x80 ->
     n :: encode' ns
@@ -32,7 +32,7 @@ and decode' = function
   | [] -> []
   | b1::bs when b1 < 0x80 ->
     code 0x0 b1 :: decode' bs
-  | b1::bs when b1 < 0xc0 ->
+  | b1::_bs when b1 < 0xc0 ->
     raise Utf8
   | b1::b2::bs when b1 < 0xe0 ->
     code 0x80 ((b1 land 0x1f) lsl 6 + con b2) :: decode' bs

interpreter/dune

@@ -34,11 +34,6 @@
  (ocamlyacc
   (modules parser)))
 
-(env
- (_
-  (flags
-   (-w +a-4-27-42-44-45-70 -warn-error +a-3))))
-
 (rule
  (alias runtest)
  (deps

interpreter/exec/eval.ml

@@ -102,7 +102,7 @@ let func_ref inst x i at =
   | _ -> Crash.error at ("type mismatch for element " ^ Int32.to_string i)
 
 let func_type_of = function
-  | Func.AstFunc (t, inst, f) -> t
+  | Func.AstFunc (t, _inst, _f) -> t
   | Func.HostFunc (t, _) -> t
 
 let block_type inst bt =
@@ -166,7 +166,7 @@ let rec step (c : config) : config =
         vs', [Label (n2, [], (args, List.map plain es')) @@ e.at]
 
       | Loop (bt, es'), vs ->
-        let FuncType (ts1, ts2) = block_type frame.inst bt in
+        let FuncType (ts1, _ts2) = block_type frame.inst bt in
         let n1 = Lib.List32.length ts1 in
         let args, vs' = take n1 vs e.at, drop n1 vs e.at in
         vs', [Label (n1, [e' @@ e.at], (args, List.map plain es')) @@ e.at]
@@ -205,7 +205,7 @@ let rec step (c : config) : config =
         else
           vs, [Invoke func @@ e.at]
 
-      | Drop, v :: vs' ->
+      | Drop, _v :: vs' ->
         vs', []
 
       | Select _, Num (I32 i) :: v2 :: v1 :: vs' ->
@@ -361,7 +361,7 @@ let rec step (c : config) : config =
           vs', []
         with exn -> vs', [Trapping (memory_error e.at exn) @@ e.at]);
 
-      | VecLoadLane ({offset; ty; pack; _}, j), Vec (V128 v) :: Num (I32 i) :: vs' ->
+      | VecLoadLane ({offset; ty = _; pack; _}, j), Vec (V128 v) :: Num (I32 i) :: vs' ->
         let mem = memory frame.inst (0l @@ e.at) in
         let addr = I64_convert.extend_i32_u i in
         (try
@@ -382,7 +382,7 @@ let rec step (c : config) : config =
           in Vec (V128 v) :: vs', []
         with exn -> vs', [Trapping (memory_error e.at exn) @@ e.at])
 
-      | VecStoreLane ({offset; ty; pack; _}, j), Vec (V128 v) :: Num (I32 i) :: vs' ->
+      | VecStoreLane ({offset; ty = _; pack; _}, j), Vec (V128 v) :: Num (I32 i) :: vs' ->
         let mem = memory frame.inst (0l @@ e.at) in
         let addr = I64_convert.extend_i32_u i in
         (try
@@ -592,62 +592,62 @@ let rec step (c : config) : config =
     | Refer r, vs ->
       Ref r :: vs, []
 
-    | Trapping msg, vs ->
+    | Trapping _msg, _vs ->
       assert false
 
-    | Returning vs', vs ->
+    | Returning _vs', _vs ->
       Crash.error e.at "undefined frame"
 
-    | Breaking (k, vs'), vs ->
+    | Breaking (_k, _vs'), _vs ->
       Crash.error e.at "undefined label"
 
-    | Label (n, es0, (vs', [])), vs ->
+    | Label (_n, _es0, (vs', [])), vs ->
       vs' @ vs, []
 
-    | Label (n, es0, (vs', {it = Trapping msg; at} :: es')), vs ->
+    | Label (_n, _es0, (_vs', {it = Trapping msg; at} :: _es')), vs ->
       vs, [Trapping msg @@ at]
 
-    | Label (n, es0, (vs', {it = Returning vs0; at} :: es')), vs ->
+    | Label (_n, _es0, (_vs', {it = Returning vs0; at} :: _es')), vs ->
       vs, [Returning vs0 @@ at]
 
-    | Label (n, es0, (vs', {it = Breaking (0l, vs0); at} :: es')), vs ->
+    | Label (n, es0, (_vs', {it = Breaking (0l, vs0); at = _} :: _es')), vs ->
       take n vs0 e.at @ vs, List.map plain es0
 
-    | Label (n, es0, (vs', {it = Breaking (k, vs0); at} :: es')), vs ->
+    | Label (_n, _es0, (_vs', {it = Breaking (k, vs0); at} :: _es')), vs ->
       vs, [Breaking (Int32.sub k 1l, vs0) @@ at]
 
     | Label (n, es0, code'), vs ->
       let c' = step {c with code = code'} in
       vs, [Label (n, es0, c'.code) @@ e.at]
 
-    | Frame (n, frame', (vs', [])), vs ->
+    | Frame (_n, _frame', (vs', [])), vs ->
       vs' @ vs, []
 
-    | Frame (n, frame', (vs', {it = Trapping msg; at} :: es')), vs ->
+    | Frame (_n, _frame', (_vs', {it = Trapping msg; at} :: _es')), vs ->
       vs, [Trapping msg @@ at]
 
-    | Frame (n, frame', (vs', {it = Returning vs0; at} :: es')), vs ->
+    | Frame (n, _frame', (_vs', {it = Returning vs0; at = _} :: _es')), vs ->
       take n vs0 e.at @ vs, []
 
     | Frame (n, frame', code'), vs ->
       let c' = step {frame = frame'; code = code'; budget = c.budget - 1} in
       vs, [Frame (n, c'.frame, c'.code) @@ e.at]
 
-    | Invoke func, vs when c.budget = 0 ->
+    | Invoke _func, _vs when c.budget = 0 ->
       Exhaustion.error e.at "call stack exhausted"
 
     | Invoke func, vs ->
       let FuncType (ins, out) = func_type_of func in
       let n1, n2 = Lib.List32.length ins, Lib.List32.length out in
       let args, vs' = take n1 vs e.at, drop n1 vs e.at in
       (match func with
-      | Func.AstFunc (t, inst', f) ->
+      | Func.AstFunc (_t, inst', f) ->
         let locals' = List.rev args @ List.map default_value f.it.locals in
         let frame' = {inst = !inst'; locals = List.map ref locals'} in
         let instr' = [Label (n2, [], ([], List.map plain f.it.body)) @@ f.at] in
         vs', [Frame (n2, frame', ([], instr')) @@ e.at]
 
-      | Func.HostFunc (t, f) ->
+      | Func.HostFunc (_t, f) ->
         try List.rev (f (List.rev args)) @ vs', []
         with Crash (_, msg) -> Crash.error e.at msg
       )
@@ -659,18 +659,18 @@ let rec eval (c : config) : value stack =
   | vs, [] ->
     vs
 
-  | vs, {it = Trapping msg; at} :: _ ->
+  | _vs, {it = Trapping msg; at} :: _ ->
     Trap.error at msg
 
-  | vs, es ->
+  | _vs, _es ->
     eval (step c)
 
 
 (* Functions & Constants *)
 
 let invoke (func : func_inst) (vs : value list) : value list =
   let at = match func with Func.AstFunc (_, _, f) -> f.at | _ -> no_region in
-  let FuncType (ins, out) = Func.type_of func in
+  let FuncType (ins, _out) = Func.type_of func in
   if List.length vs <> List.length ins then
     Crash.error at "wrong number of arguments";
   if not (List.for_all2 (fun v -> (=) (type_of_value v)) vs ins) then
@@ -683,20 +683,20 @@ let eval_const (inst : module_inst) (const : const) : value =
   let c = config inst [] (List.map plain const.it) in
   match eval c with
   | [v] -> v
-  | vs -> Crash.error const.at "wrong number of results on stack"
+  | _vs -> Crash.error const.at "wrong number of results on stack"
 
 
 (* Modules *)
 
 let create_func (inst : module_inst) (f : func) : func_inst =
   Func.alloc (type_ inst f.it.ftype) (ref inst) f
 
-let create_table (inst : module_inst) (tab : table) : table_inst =
+let create_table (_inst : module_inst) (tab : table) : table_inst =
   let {ttype} = tab.it in
   let TableType (_lim, t) = ttype in
   Table.alloc ttype (NullRef t)
 
-let create_memory (inst : module_inst) (mem : memory) : memory_inst =
+let create_memory (_inst : module_inst) (mem : memory) : memory_inst =
   let {mtype} = mem.it in
   Memory.alloc mtype
 
@@ -716,10 +716,10 @@ let create_export (inst : module_inst) (ex : export) : export_inst =
   in (name, ext)
 
 let create_elem (inst : module_inst) (seg : elem_segment) : elem_inst =
-  let {etype; einit; _} = seg.it in
+  let {etype = _; einit; _} = seg.it in
   Elem.alloc (List.map (fun c -> as_ref (eval_const inst c)) einit)
 
-let create_data (inst : module_inst) (seg : data_segment) : data_inst =
+let create_data (_inst : module_inst) (seg : data_segment) : data_inst =
   let {dinit; _} = seg.it in
   Data.alloc dinit
 

interpreter/exec/eval_num.ml

@@ -89,7 +89,7 @@ struct
       | CopySign -> FXX.copysign
     in fun v1 v2 -> to_num (f (of_num 1 v1) (of_num 2 v2))
 
-  let testop op = assert false
+  let testop _op = assert false
 
   let relop op =
     let f = match op with

interpreter/exec/ixx.ml

@@ -175,7 +175,7 @@ struct
 
   (* result is floored (which is the same as truncating for unsigned values) *)
   let div_u x y =
-    let q, r = divrem_u x y in q
+    let q, _r = divrem_u x y in q
 
   (* result has the sign of the dividend *)
   let rem_s x y =
@@ -185,7 +185,7 @@ struct
       Rep.rem x y
 
   let rem_u x y =
-    let q, r = divrem_u x y in r
+    let _q, r = divrem_u x y in r
 
   let avgr_u x y =
     let open Int64 in

interpreter/exec/v128.ml

@@ -109,7 +109,7 @@ struct
   let reduceop f a s = List.fold_left (fun a b -> f a (b <> IXX.zero)) a (to_lanes s)
   let cmp f x y = if f x y then IXX.of_int_s (-1) else IXX.zero
 
-  let splat x = of_lanes (List.init num_lanes (fun i -> x))
+  let splat x = of_lanes (List.init num_lanes (fun _i -> x))
   let extract_lane_s i s = List.nth (to_lanes s) i
   let extract_lane_u i s = IXX.as_unsigned (extract_lane_s i s)
   let replace_lane i v x = unopi (fun j y -> if j = i then x else y) v
@@ -212,7 +212,7 @@ struct
   let all_ones = FXX.of_float (Int64.float_of_bits (Int64.minus_one))
   let cmp f x y = if f x y then all_ones else FXX.zero
 
-  let splat x = of_lanes (List.init num_lanes (fun i -> x))
+  let splat x = of_lanes (List.init num_lanes (fun _i -> x))
   let extract_lane i s = List.nth (to_lanes s) i
   let replace_lane i v x = unopi (fun j y -> if j = i then x else y) v
 

interpreter/host/env.ml

@@ -18,12 +18,12 @@ let type_error v t =
 
 let empty = function
   | [] -> ()
-  | vs -> error "type error, too many arguments"
+  | _vs -> error "type error, too many arguments"
 
 let single = function
   | [] -> error "type error, missing arguments"
   | [v] -> v
-  | vs -> error "type error, too many arguments"
+  | _vs -> error "type error, too many arguments"
 
 let int = function
   | Num (I32 i) -> Int32.to_int i

interpreter/runtime/table.ml

@@ -51,7 +51,7 @@ let load tab i =
   Lib.Array32.get tab.content i
 
 let store tab i r =
-  let TableType (lim, t) = tab.ty in
+  let TableType (_lim, t) = tab.ty in
   if type_of_ref r <> t then raise Type;
   if i < 0l || i >= Lib.Array32.length tab.content then raise Bounds;
   Lib.Array32.set tab.content i r

interpreter/script/import.ml

@@ -10,7 +10,7 @@ let registry = ref Registry.empty
 let register name lookup = registry := Registry.add name lookup !registry
 
 let lookup (m : module_) (im : import) : Instance.extern =
-  let {module_name; item_name; idesc} = im.it in
+  let {module_name; item_name; idesc = _} = im.it in
   let t = import_type m im in
   try Registry.find module_name !registry item_name t with Not_found ->
     Unknown.error im.at

interpreter/script/js.ml

@@ -217,7 +217,7 @@ let bind (mods : modules) x_opt m =
 let lookup (mods : modules) x_opt name at =
   let exports =
     try Map.find (of_var_opt mods x_opt) mods.env with Not_found ->
-      raise (Eval.Crash (at, 
+      raise (Eval.Crash (at,
         if x_opt = None then "no module defined within script"
         else "unknown module " ^ of_var_opt mods x_opt ^ " within script"))
   in try NameMap.find name exports with Not_found ->
@@ -275,10 +275,10 @@ let invoke ft vs at =
 let get t at =
   [], GlobalImport t @@ at, [GlobalGet (subject_idx @@ at) @@ at]
 
-let run ts at =
+let run _ts _at =
   [], []
 
-let assert_return ress ts at =
+let assert_return ress _ts at =
   let test res =
     let nan_bitmask_of = function
       | CanonicalNan -> abs_mask_of (* must only differ from the canonical NaN in its sign bit *)
@@ -354,7 +354,7 @@ let assert_return ress ts at =
         VecTest (V128 (V128.I8x16 V128Op.AllTrue)) @@ at;
         Test (I32 I32Op.Eqz) @@ at;
         BrIf (0l @@ at) @@ at ]
-    | RefResult (RefPat {it = Values.NullRef t; _}) ->
+    | RefResult (RefPat {it = Values.NullRef _t; _}) ->
       [ RefIsNull @@ at;
         Test (Values.I32 I32Op.Eqz) @@ at;
         BrIf (0l @@ at) @@ at ]
@@ -425,8 +425,8 @@ let is_js_num_type = function
 
 let is_js_value_type = function
   | NumType t -> is_js_num_type t
-  | VecType t -> false
-  | RefType t -> true
+  | VecType _t -> false
+  | RefType _t -> true
 
 let is_js_global_type = function
   | GlobalType (t, mut) -> is_js_value_type t && mut = Immutable
@@ -508,7 +508,7 @@ let of_num_pat = function
     | Values.F32 n | Values.F64 n -> of_nan n
 
 let of_vec_pat = function
-  | VecPat (Values.V128 (shape, pats)) ->
+  | VecPat (Values.V128 (_shape, pats)) ->
     Printf.sprintf "v128(\"%s\")" (String.concat " " (List.map of_num_pat pats))
 
 let of_ref_pat = function

interpreter/script/run.ml

@@ -155,7 +155,7 @@ let input_binary_file file run =
     success
   with exn -> close_in ic; raise exn
 
-let input_js_file file run =
+let input_js_file file _run =
   raise (Sys_error (file ^ ": unrecognized input file type"))
 
 let input_file file run =
@@ -268,7 +268,7 @@ let string_of_num_pat (p : num_pat) =
 
 let string_of_vec_pat (p : vec_pat) =
   match p with
-  | VecPat (Values.V128 (shape, ns)) ->
+  | VecPat (Values.V128 (_shape, ns)) ->
     String.concat " " (List.map string_of_num_pat ns)
 
 let string_of_ref_pat (p : ref_pat) =
@@ -347,7 +347,7 @@ let run_action act : Values.value list =
     let inst = lookup_instance x_opt act.at in
     (match Instance.export inst name with
     | Some (Instance.ExternFunc f) ->
-      let Types.FuncType (ins, out) = Func.type_of f in
+      let Types.FuncType (ins, _out) = Func.type_of f in
       if List.length vs <> List.length ins then
         Script.error act.at "wrong number of arguments";
       List.iter2 (fun v t ->