Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

fix warnings and enable them again #1664

Open
wants to merge 2 commits into
base: main
Choose a base branch
from
Open

fix warnings and enable them again #1664

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
92acc13
use the default set of warnings
zapashcanon Nov 10, 2023
4eaaa5e
Merge branch 'main' into warnings
zapashcanon Nov 14, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 2 additions & 2 deletions interpreter/binary/decode.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -944,7 +944,7 @@ let code_section s =

(* Element section *)

let passive s =
let passive _s =
Passive

let active s =
Expand All @@ -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 =
Expand Down
4 changes: 2 additions & 2 deletions interpreter/binary/utf8.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down
5 changes: 0 additions & 5 deletions interpreter/dune
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -47,11 +47,6 @@
(menhir
(modules parser)))

(env
(_
(flags
(-w +a-4-27-42-44-45-70 -warn-error +a-3))))
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Except for removing 27, I think we still want to keep this declaration for stricter checking? The default is much more lax, no?

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

The default of the OCaml compiler are more lax. Dune has its own set of warnings which is much more stricter.

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Not stricter than this, AFAICT.


(rule
(alias runtest)
(deps
Expand Down
54 changes: 27 additions & 27 deletions interpreter/exec/eval.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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 =
Expand Down Expand Up @@ -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]
Expand Down Expand Up @@ -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' ->
Expand Down Expand Up @@ -362,7 +362,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; 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
Expand All @@ -383,7 +383,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; 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
Expand Down Expand Up @@ -594,62 +594,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); _ } :: _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; _} :: _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
)
Expand All @@ -661,18 +661,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
Expand All @@ -685,20 +685,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

Expand All @@ -718,10 +718,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 { 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

Expand Down
2 changes: 1 addition & 1 deletion interpreter/exec/eval_num.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
4 changes: 2 additions & 2 deletions interpreter/exec/ixx.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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 =
Expand All @@ -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
Expand Down
4 changes: 2 additions & 2 deletions interpreter/exec/v128.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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

Expand Down
4 changes: 2 additions & 2 deletions interpreter/host/env.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion interpreter/runtime/table.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion interpreter/script/import.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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; _} = 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
Expand Down
14 changes: 7 additions & 7 deletions interpreter/script/js.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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 ->
Expand Down Expand Up @@ -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 *)
Expand Down Expand Up @@ -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 ]
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
6 changes: 3 additions & 3 deletions interpreter/script/run.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -162,7 +162,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 =
Expand Down Expand Up @@ -275,7 +275,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) =
Expand Down Expand Up @@ -354,7 +354,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 ->
Expand Down
Loading
Loading