clean some code in the fuzzer

src/ast/types.ml

@@ -70,7 +70,7 @@ let pp_num_type fmt = function
 let num_type_eq t1 t2 =
   match (t1, t2) with
   | I32, I32 | I64, I64 | F32, F32 | F64, F64 -> true
-  | _, _ -> false
+  | (I32 | I64 | F32 | F64), _ -> false
 
 let compare_num_type t1 t2 =
   let to_int = function I32 -> 0 | I64 -> 1 | F32 -> 2 | F64 -> 3 in
@@ -101,6 +101,8 @@ type nonrec mut =
 
 let pp_mut fmt = function Const -> () | Var -> pf fmt "mut"
 
+let is_mut = function Const -> false | Var -> true
+
 type nonrec nn =
   | S32
   | S64

test/fuzz/basic.ml

@@ -418,7 +418,7 @@ let memory_exists (env : Env.t) = Option.is_some env.memory
 
 let memarg nsize =
   let* offset = int32 in
-  let offset = if offset < 0l then Int32.sub 0l offset else offset in
+  let offset = if Owi.Int32.lt offset 0l then Int32.sub 0l offset else offset in
   let+ align =
     match nsize with
     | NS8 -> const 0
@@ -549,11 +549,13 @@ let table_copy (env : Env.t) =
     let instr =
       let* name_x, (_lim_x, rt_x) = choose tables in
       let* name_y, (_lim_y, rt_y) = choose tables in
-      if rt_x = rt_y then
+      match (rt_x, rt_y) with
+      | ((Null, ht1), (Null, ht2) | (No_null, ht1), (No_null, ht2))
+        when heap_type_eq ht1 ht2 ->
         pair
           (const (Table_copy (Text name_x, Text name_y)))
           (const [ S.Pop; S.Pop; S.Pop ])
-      else pair (const Nop) (const [ S.Nothing ])
+      | _ -> pair (const Nop) (const [ S.Nothing ])
       (* TODO: avoid if ... then ... else pair (const (Nop)) (const [ S.Nothing ])
          https://github.com/OCamlPro/owi/pull/28#discussion_r1275222846 *)
     in

test/fuzz/env.ml

@@ -63,7 +63,7 @@ let get_blocks env = env.blocks
 
 let add_data env =
   let n = env.next_data in
-  let name = Format.sprintf "d%d" n in
+  let name = Fmt.str "d%d" n in
   env.datas <- name :: env.datas;
   env.next_data <- succ n;
   name
@@ -72,57 +72,57 @@ let add_memory env =
   match env.memory with
   | None ->
     let n = env.next_memory in
-    let name = Format.sprintf "m%d" n in
+    let name = Fmt.str "m%d" n in
     env.memory <- Some name;
     env.next_memory <- succ n;
     name
-  | Some _ -> failwith "a memory already exists"
+  | Some _ -> assert false
 
 let add_type env typ =
   let n = env.next_type in
-  let name = Format.sprintf "ty%d" n in
+  let name = Fmt.str "ty%d" n in
   env.types <- (name, typ) :: env.types;
   env.next_type <- succ n;
   name
 
 let add_elem env typ =
   let n = env.next_elem in
-  let name = Format.sprintf "e%d" n in
+  let name = Fmt.str "e%d" n in
   env.elems <- (name, typ) :: env.elems;
   env.next_elem <- succ n;
   name
 
 let add_table env typ =
   let n = env.next_table in
-  let name = Format.sprintf "t%d" n in
+  let name = Fmt.str "t%d" n in
   env.tables <- (name, typ) :: env.tables;
   env.next_table <- succ n;
   name
 
 let add_global env typ =
   let n = env.next_global in
-  let name = Format.sprintf "g%d" n in
+  let name = Fmt.str "g%d" n in
   env.globals <- (name, typ) :: env.globals;
   env.next_global <- succ n;
   name
 
 let add_local env typ =
   let n = env.next_local in
-  let name = Format.sprintf "l%d" n in
+  let name = Fmt.str "l%d" n in
   env.locals <- (name, typ) :: env.locals;
   env.next_local <- succ n;
   name
 
 let add_block env typ bkind =
   let n = env.next_block in
-  let name = Format.sprintf "b%d" n in
+  let name = Fmt.str "b%d" n in
   env.blocks <- (bkind, name, typ) :: env.blocks;
   env.next_block <- succ n;
   name
 
 let add_func env typ =
   let n = env.next_fun in
-  let name = Format.sprintf "f%d" n in
+  let name = Fmt.str "f%d" n in
   env.next_fun <- succ n;
   env.funcs <- (name, typ) :: env.funcs;
   name
@@ -131,15 +131,15 @@ let get_globals ntyp env ~only_mut =
   let is_typ global =
     let _, (m, v) = global in
     match v with
-    | Num_type nt -> nt = ntyp && ((not only_mut) || m = Owi.Types.Var)
+    | Num_type nt -> num_type_eq ntyp nt && ((not only_mut) || is_mut m)
     | Ref_type _ -> false
   in
   List.filter is_typ env.globals
 
 let get_locals ntyp env =
   let is_typ local =
     let _, v = local in
-    match v with Num_type nt -> nt = ntyp | Ref_type _ -> false
+    match v with Num_type nt -> num_type_eq nt ntyp | Ref_type _ -> false
   in
   List.filter is_typ env.locals
 

test/fuzz/interprets.ml

@@ -19,10 +19,12 @@ let set =
   let raise n = if n = -2 then raise Timeout in
   fun () ->
     Sys.set_signal Sys.sigalrm (Sys.Signal_handle raise);
-    ignore
-    @@ ( Unix.setitimer Unix.ITIMER_REAL
-           { Unix.it_interval = 0.; Unix.it_value = Param.max_time_execution }
-         : Unix.interval_timer_status )
+    let _ : Unix.interval_timer_status =
+      ( Unix.setitimer Unix.ITIMER_REAL
+          { Unix.it_interval = 0.; Unix.it_value = Param.max_time_execution }
+        : Unix.interval_timer_status )
+    in
+    ()
 
 let timeout_call_run (run : unit -> unit Result.t) : 'a Result.t =
   try

test/fuzz/type_stack.ml

@@ -21,8 +21,8 @@ let rec is_stack_compatible st1 st2 =
   match (st1, st2) with
   | _, [] -> true
   | [], _ -> false
-  | s1 :: st1, s2 :: st2 -> s1 = s2 && is_stack_compatible st1 st2
+  | s1 :: st1, s2 :: st2 -> val_type_eq s1 s2 && is_stack_compatible st1 st2
 
 let is_stack_compatible_param stack pt =
-  let s = List.map (fun p -> snd p) pt in
+  let s = List.map snd pt in
   is_stack_compatible stack s