Misc: reduce usage of polymorphic ops (#1941)

Co-authored-by: Jérôme Vouillon <[email protected]>

Author: hhugo

compiler/bin-js_of_ocaml/check_runtime.ml

@@ -23,10 +23,10 @@ open Js_of_ocaml_compiler
 let group_by_snd l =
   l
   |> List.sort_uniq ~cmp:(fun (n1, l1) (n2, l2) ->
-         match Poly.compare l1 l2 with
+         match List.compare ~cmp:String.compare l1 l2 with
          | 0 -> String.compare n1 n2
          | c -> c)
-  |> List.group ~f:(fun (_, g1) (_, g2) -> Poly.equal g1 g2)
+  |> List.group ~f:(fun (_, g1) (_, g2) -> List.equal ~eq:String.equal g1 g2)
 
 let print_groups output l =
   List.iter l ~f:(fun group ->

compiler/bin-wasm_of_ocaml/compile.ml

@@ -96,10 +96,13 @@ let build_runtime ~runtime_file =
   in
   match
     List.find_opt Runtime_files.precompiled_runtimes ~f:(fun (flags, _) ->
-        assert (
-          List.length flags = List.length variables
-          && List.for_all2 ~f:(fun (k, _) (k', _) -> String.equal k k') flags variables);
-        Poly.equal flags variables)
+        assert (List.length flags = List.length variables);
+        List.equal
+          ~eq:(fun (k1, v1) (k2, v2) ->
+            assert (String.equal k1 k2);
+            Wat_preprocess.value_equal v1 v2)
+          flags
+          variables)
   with
   | Some (_, contents) -> Fs.write_file ~name:runtime_file ~contents
   | None ->

compiler/lib-wasm/binaryen.ml

@@ -127,7 +127,8 @@ let optimize
   let level =
     match profile with
     | None -> 1
-    | Some p -> fst (List.find ~f:(fun (_, p') -> Poly.equal p p') Driver.profiles)
+    | Some p ->
+        fst (List.find ~f:(fun (_, p') -> Driver.profile_equal p p') Driver.profiles)
   in
   command
     ("wasm-opt"

compiler/lib-wasm/code_generation.ml

@@ -378,7 +378,7 @@ module Arith = struct
     let* e' = e' in
     return
       (match e, e' with
-      | W.Const (I32 n), W.Const (I32 n') when Poly.(n' < 31l) ->
+      | W.Const (I32 n), W.Const (I32 n') when Int32.(n' < 31l) ->
           W.Const (I32 (Int32.shift_left n (Int32.to_int n')))
       | _ -> W.BinOp (I32 Shl, e, e'))
 

compiler/lib-wasm/link.ml

@@ -868,7 +868,7 @@ let add_source_map files z sm =
   Wasm_source_map.iter_sources sm (fun i j file ->
       let z', files =
         match !st with
-        | Some (i', st) when Poly.equal i i' -> st
+        | Some (i', st) when Option.equal ( = ) i i' -> st
         | _ ->
             let st' = get_source_map_files ~tmp_buf files src_index in
             finalize ();

compiler/lib-wasm/wasm_link.ml

@@ -107,6 +107,23 @@ type exportable =
   | Global
   | Tag
 
+let heaptype_eq t1 t2 =
+  Stdlib.phys_equal t1 t2
+  ||
+  match t1, t2 with
+  | Type i1, Type i2 -> i1 = i2
+  | _ -> false
+
+let reftype_eq { nullable = n1; typ = t1 } { nullable = n2; typ = t2 } =
+  Bool.(n1 = n2) && heaptype_eq t1 t2
+
+let valtype_eq t1 t2 =
+  Stdlib.phys_equal t1 t2
+  ||
+  match t1, t2 with
+  | Ref t1, Ref t2 -> reftype_eq t1 t2
+  | _ -> false
+
 let rec output_uint ch i =
   if i < 128
   then output_byte ch i
@@ -489,23 +506,6 @@ module Read = struct
       (* We have large structs, that tend to hash to the same value *)
       Hashtbl.hash_param 15 100 t
 
-    let heaptype_eq t1 t2 =
-      Stdlib.phys_equal t1 t2
-      ||
-      match t1, t2 with
-      | Type i1, Type i2 -> i1 = i2
-      | _ -> false
-
-    let reftype_eq { nullable = n1; typ = t1 } { nullable = n2; typ = t2 } =
-      Bool.(n1 = n2) && heaptype_eq t1 t2
-
-    let valtype_eq t1 t2 =
-      Stdlib.phys_equal t1 t2
-      ||
-      match t1, t2 with
-      | Ref t1, Ref t2 -> reftype_eq t1 t2
-      | _ -> false
-
     let storagetype_eq t1 t2 =
       match t1, t2 with
       | Val v1, Val v2 -> valtype_eq v1 v2
@@ -1583,11 +1583,11 @@ let check_export_import_types ~subtyping_info ~files i (desc : importdesc) i' im
     match desc, import.desc with
     | Func t, Func t' -> subtype subtyping_info t t'
     | Table { limits; typ }, Table { limits = limits'; typ = typ' } ->
-        check_limits limits limits' && Poly.(typ = typ')
+        check_limits limits limits' && reftype_eq typ typ'
     | Mem limits, Mem limits' -> check_limits limits limits'
     | Global { mut; typ }, Global { mut = mut'; typ = typ' } ->
         Bool.(mut = mut')
-        && if mut then Poly.(typ = typ') else val_subtype subtyping_info typ typ'
+        && if mut then valtype_eq typ typ' else val_subtype subtyping_info typ typ'
     | Tag t, Tag t' -> t = t'
     | _ -> false
   in

compiler/lib-wasm/wasm_output.ml

@@ -106,7 +106,7 @@ end = struct
       output_sint ch (i asr 7))
 
   let output_sint32 ch i =
-    if Poly.(i >= -64l && i < 64l)
+    if Int32.(i >= -64l && i < 64l)
     then
       let i = Int32.to_int i in
       if i >= 0 then output_byte ch i else output_byte ch (i + 128)
@@ -115,7 +115,7 @@ end = struct
       output_sint ch (Int32.to_int (Int32.shift_right i 7)))
 
   let rec output_sint64 ch i =
-    if Poly.(i >= -64L && i < 64L)
+    if Int64.(i >= -64L && i < 64L)
     then
       let i = Int64.to_int i in
       if i >= 0 then output_byte ch i else output_byte ch (i + 128)

compiler/lib-wasm/wat_output.ml

@@ -302,7 +302,12 @@ type ctx = { mutable function_refs : Code.Var.Set.t }
 
 let reference_function ctx f = ctx.function_refs <- Code.Var.Set.add f ctx.function_refs
 
-let remove_nops l = List.filter ~f:(fun i -> not (Poly.equal i Nop)) l
+let remove_nops l =
+  List.filter
+    ~f:(function
+      | Nop -> false
+      | _ -> true)
+    l
 
 let float64 _ f =
   match classify_float f with
@@ -604,7 +609,7 @@ let escape_string s =
   let b = Buffer.create (String.length s + 2) in
   for i = 0 to String.length s - 1 do
     let c = s.[i] in
-    if Poly.(c >= ' ' && c <= '~' && c <> '"' && c <> '\\')
+    if Char.(c >= ' ' && c <= '~' && c <> '"' && c <> '\\')
     then Buffer.add_char b c
     else Printf.bprintf b "\\%02x" (Char.code c)
   done;

compiler/lib-wasm/wat_preprocess.ml

@@ -277,6 +277,10 @@ type value =
   | String of string
   | Version of int * int * int
 
+let value_equal (a : value) b = Poly.equal a b
+
+let value_compare (a : value) b = Poly.compare a b
+
 type st =
   { text : string
   ; mutable pos : pos
@@ -305,7 +309,7 @@ let check_type ?typ expr actual_typ =
   match typ with
   | None -> ()
   | Some typ ->
-      if Poly.(actual_typ <> typ)
+      if not (Poly.equal actual_typ typ)
       then
         raise
           (Error
@@ -367,15 +371,17 @@ and bin_op st ?typ loc op args =
       let v = eval st expr in
       let v' = eval ~typ:(value_type v) st expr' in
       Bool
-        Poly.(
-          match op with
-          | "=" -> v = v'
-          | "<" -> v < v'
-          | ">" -> v > v'
-          | "<=" -> v <= v'
-          | ">=" -> v >= v'
-          | "<>" -> v <> v'
-          | _ -> assert false)
+        (let op =
+           match op with
+           | "=" -> ( = )
+           | "<" -> ( < )
+           | ">" -> ( > )
+           | "<=" -> ( <= )
+           | ">=" -> ( >= )
+           | "<>" -> ( <> )
+           | _ -> assert false
+         in
+         op (value_compare v v') 0)
   | _ -> raise (Error (position_of_loc loc, Printf.sprintf "Syntax error.\n"))
 
 (****)

compiler/lib-wasm/wat_preprocess.mli

@@ -3,6 +3,8 @@ type value =
   | String of string
   | Version of int * int * int
 
+val value_equal : value -> value -> bool
+
 val f : variables:(string * value) list -> filename:string -> contents:string -> string
 
 type source =