Skip to content

Commit

Permalink
fix warnings and enable them again
Browse files Browse the repository at this point in the history
  • Loading branch information
zapashcanon committed Jun 13, 2023
1 parent f2ab415 commit a808782
Show file tree
Hide file tree
Showing 18 changed files with 152 additions and 157 deletions.
4 changes: 2 additions & 2 deletions interpreter/binary/decode.ml
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
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
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
54 changes: 27 additions & 27 deletions interpreter/exec/eval.ml
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 @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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
)
Expand All @@ -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
Expand All @@ -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

Expand All @@ -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

Expand Down
2 changes: 1 addition & 1 deletion interpreter/exec/eval_num.ml
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
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
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
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
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
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; 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
Expand Down
14 changes: 7 additions & 7 deletions interpreter/script/js.ml
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
Original file line number Diff line number Diff line change
Expand Up @@ -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 =
Expand Down Expand Up @@ -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) =
Expand Down Expand Up @@ -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 ->
Expand Down
Loading

0 comments on commit a808782

Please sign in to comment.