Compiler: phys_equal hints

Author: hhugo

compiler/lib/generate.ml

@@ -374,6 +374,8 @@ let plus_int x y =
 
 let bool e = J.ECond (e, one, zero)
 
+let bool_not e = J.ECond (e, zero, one)
+
 (****)
 
 let source_location loc =
@@ -1547,6 +1549,24 @@ let rec translate_expr ctx loc x e level : (_ * J.statement_list) Expr_builder.t
               | _ -> J.EBin (J.Plus, ca, cb)
             in
             return (add ca cb)
+        | Extern "%phys_equal", [ x; y ] ->
+            let* cx = access' ~ctx x in
+            let* cy = access' ~ctx y in
+            return
+              (bool
+                 (J.call
+                    (J.dot (s_var "Object") (Utf8_string.of_string_exn "is"))
+                    [ cx; cy ]
+                    loc))
+        | Extern "%not_phys_equal", [ x; y ] ->
+            let* cx = access' ~ctx x in
+            let* cy = access' ~ctx y in
+            return
+              (bool_not
+                 (J.call
+                    (J.dot (s_var "Object") (Utf8_string.of_string_exn "is"))
+                    [ cx; cy ]
+                    loc))
         | Extern name_orig, l -> (
             let name = Primitive.resolve name_orig in
             match internal_prim name with

compiler/lib/parse_bytecode.ml

@@ -368,6 +368,7 @@ module Hints = struct
         ; layout : Lambda.bigarray_layout
         }
     | Hint_primitive of Primitive.description
+    | Hint_phys_equal
 
   type t = { hints : optimization_hint Int.Hashtbl.t }
 
@@ -2320,23 +2321,33 @@ and compile infos pc state (instrs : instr list) =
 
         if debug_parser ()
         then Format.printf "%a = mk_bool(%a == %a)@." Var.print x Var.print y Var.print z;
+        let hints = Hints.find infos.hints pc in
+        let prim =
+          if List.mem Hints.Hint_phys_equal ~set:hints then Extern "%phys_equal" else Eq
+        in
         compile
           infos
           (pc + 1)
           (State.pop 1 state)
-          (Let (x, Prim (Eq, [ Pv y; Pv z ])) :: instrs)
+          (Let (x, Prim (prim, [ Pv y; Pv z ])) :: instrs)
     | NEQ ->
         let y = State.accu state in
         let z = State.peek 0 state in
         let x, state = State.fresh_var state in
 
         if debug_parser ()
         then Format.printf "%a = mk_bool(%a != %a)@." Var.print x Var.print y Var.print z;
+        let hints = Hints.find infos.hints pc in
+        let prim =
+          if List.mem Hints.Hint_phys_equal ~set:hints
+          then Extern "%not_phys_equal"
+          else Neq
+        in
         compile
           infos
           (pc + 1)
           (State.pop 1 state)
-          (Let (x, Prim (Neq, [ Pv y; Pv z ])) :: instrs)
+          (Let (x, Prim (prim, [ Pv y; Pv z ])) :: instrs)
     | LTINT ->
         let y = State.accu state in
         let z = State.peek 0 state in