Merge commit '017d4a3eaddbd2b25649d04ed576258e4ddf60cc' into parallel_minor_gc_4_11b

8 files changed, 28 insertions, 1 deletions

diff --git a/middle_end/clambda_primitives.ml b/middle_end/clambda_primitives.ml
index 0b4a9d334e..eace031fab 100644
--- a/middle_end/clambda_primitives.ml
+++ b/middle_end/clambda_primitives.ml
@@ -58,6 +58,7 @@ type primitive =
   | Pandint | Porint | Pxorint
   | Plslint | Plsrint | Pasrint
   | Pintcomp of integer_comparison
+  | Pcompare_ints | Pcompare_floats | Pcompare_bints of boxed_integer
   | Poffsetint of int
   | Poffsetref of int
   (* Float operations *)
diff --git a/middle_end/clambda_primitives.mli b/middle_end/clambda_primitives.mli
index eeb12941f2..74daefdd95 100644
--- a/middle_end/clambda_primitives.mli
+++ b/middle_end/clambda_primitives.mli
@@ -58,6 +58,7 @@ type primitive =
   | Pandint | Porint | Pxorint
   | Plslint | Plsrint | Pasrint
   | Pintcomp of integer_comparison
+  | Pcompare_ints | Pcompare_floats | Pcompare_bints of boxed_integer
   | Poffsetint of int
   | Poffsetref of int
   (* Float operations *)
diff --git a/middle_end/convert_primitives.ml b/middle_end/convert_primitives.ml
index aca0c06180..8ea75c2e3a 100644
--- a/middle_end/convert_primitives.ml
+++ b/middle_end/convert_primitives.ml
@@ -59,6 +59,9 @@ let convert (prim : Lambda.primitive) : Clambda_primitives.primitive =
   | Plsrint -> Plsrint
   | Pasrint -> Pasrint
   | Pintcomp comp -> Pintcomp comp
+  | Pcompare_ints -> Pcompare_ints
+  | Pcompare_floats -> Pcompare_floats
+  | Pcompare_bints bi -> Pcompare_bints bi
   | Poffsetint offset -> Poffsetint offset
   | Poffsetref offset -> Poffsetref offset
   | Pintoffloat -> Pintoffloat
diff --git a/middle_end/flambda/simplify_boxed_integer_ops.ml b/middle_end/flambda/simplify_boxed_integer_ops.ml
index 1f95a1ec2d..f1a8fab841 100644
--- a/middle_end/flambda/simplify_boxed_integer_ops.ml
+++ b/middle_end/flambda/simplify_boxed_integer_ops.ml
@@ -79,6 +79,8 @@ end) : Simplify_boxed_integer_ops_intf.S with type t := I.t = struct
     | Pxorbint kind when equal_kind kind I.kind -> eval I.logxor
     | Pbintcomp (kind, c) when equal_kind kind I.kind ->
       S.const_integer_comparison_expr expr c n1 n2
+    | Pcompare_bints kind when equal_kind kind I.kind ->
+      S.const_int_expr expr (I.compare n1 n2)
     | _ -> expr, A.value_unknown Other, C.Benefit.zero
 
   let simplify_binop_int (p : Clambda_primitives.primitive)
diff --git a/middle_end/flambda/simplify_primitives.ml b/middle_end/flambda/simplify_primitives.ml
index 349d2f40ba..a228fe825f 100644
--- a/middle_end/flambda/simplify_primitives.ml
+++ b/middle_end/flambda/simplify_primitives.ml
@@ -150,7 +150,7 @@ let primitive (p : Clambda_primitives.primitive) (args, approxs)
          let a = f 1
          let b = f 1
          let c = a, a
-         let d = a, a
+         let d = b, b
 
        If [Share_constants] is run before [f] is completely inlined (assuming
        [f] always generates the same result; effects of [f] aren't in fact
@@ -194,12 +194,14 @@ let primitive (p : Clambda_primitives.primitive) (args, approxs)
       | Plsrint when shift_precond -> S.const_int_expr expr (x lsr y)
       | Pasrint when shift_precond -> S.const_int_expr expr (x asr y)
       | Pintcomp cmp -> S.const_integer_comparison_expr expr cmp x y
+      | Pcompare_ints -> S.const_int_expr expr (compare x y)
       | Pisout -> S.const_bool_expr expr (y > x || y < 0)
       | _ -> expr, A.value_unknown Other, C.Benefit.zero
       end
     | [Value_char x; Value_char y] ->
       begin match p with
       | Pintcomp cmp -> S.const_integer_comparison_expr expr cmp x y
+      | Pcompare_ints -> S.const_int_expr expr (Char.compare x y)
       | _ -> expr, A.value_unknown Other, C.Benefit.zero
       end
     | [Value_constptr x] ->
@@ -225,6 +227,7 @@ let primitive (p : Clambda_primitives.primitive) (args, approxs)
       | Pmulfloat -> S.const_float_expr expr (n1 *. n2)
       | Pdivfloat -> S.const_float_expr expr (n1 /. n2)
       | Pfloatcomp c  -> S.const_float_comparison_expr expr c n1 n2
+      | Pcompare_floats -> S.const_int_expr expr (Float.compare n1 n2)
       | _ -> expr, A.value_unknown Other, C.Benefit.zero
       end
     | [A.Value_boxed_int(A.Nativeint, n)] ->
diff --git a/middle_end/internal_variable_names.ml b/middle_end/internal_variable_names.ml
index 16f969288f..22454e7a56 100644
--- a/middle_end/internal_variable_names.ml
+++ b/middle_end/internal_variable_names.ml
@@ -123,6 +123,9 @@ let pidentity = "Pidentity"
 let pignore = "Pignore"
 let pint_as_pointer = "Pint_as_pointer"
 let pintcomp = "Pintcomp"
+let pcompare_ints = "Pcompare_ints"
+let pcompare_floats = "Pcompare_floats"
+let pcompare_bints = "Pcompare_bints"
 let pintofbint = "Pintofbint"
 let pintoffloat = "Pintoffloat"
 let pisint = "Pisint"
@@ -233,6 +236,9 @@ let pidentity_arg = "Pidentity_arg"
 let pignore_arg = "Pignore_arg"
 let pint_as_pointer_arg = "Pint_as_pointer_arg"
 let pintcomp_arg = "Pintcomp_arg"
+let pcompare_ints_arg = "Pcompare_ints_arg"
+let pcompare_floats_arg = "Pcompare_floats_arg"
+let pcompare_bints_arg = "Pcompare_bints_arg"
 let pintofbint_arg = "Pintofbint_arg"
 let pintoffloat_arg = "Pintoffloat_arg"
 let pisint_arg = "Pisint_arg"
@@ -359,6 +365,9 @@ let of_primitive : Lambda.primitive -> string = function
   | Plsrint -> plsrint
   | Pasrint -> pasrint
   | Pintcomp _ -> pintcomp
+  | Pcompare_ints -> pcompare_ints
+  | Pcompare_floats -> pcompare_floats
+  | Pcompare_bints _ -> pcompare_bints
   | Poffsetint _ -> poffsetint
   | Poffsetref _ -> poffsetref
   | Pintoffloat -> pintoffloat
@@ -472,6 +481,9 @@ let of_primitive_arg : Lambda.primitive -> string = function
   | Plsrint -> plsrint_arg
   | Pasrint -> pasrint_arg
   | Pintcomp _ -> pintcomp_arg
+  | Pcompare_ints -> pcompare_ints_arg
+  | Pcompare_floats -> pcompare_floats_arg
+  | Pcompare_bints _ -> pcompare_bints_arg
   | Poffsetint _ -> poffsetint_arg
   | Poffsetref _ -> poffsetref_arg
   | Pintoffloat -> pintoffloat_arg
diff --git a/middle_end/printclambda_primitives.ml b/middle_end/printclambda_primitives.ml
index d8f6ef6388..5c591bfc21 100644
--- a/middle_end/printclambda_primitives.ml
+++ b/middle_end/printclambda_primitives.ml
@@ -131,6 +131,9 @@ let primitive ppf (prim:Clambda_primitives.primitive) =
   | Plsrint -> fprintf ppf "lsr"
   | Pasrint -> fprintf ppf "asr"
   | Pintcomp(cmp) -> Printlambda.integer_comparison ppf cmp
+  | Pcompare_ints -> fprintf ppf "compare_ints"
+  | Pcompare_floats -> fprintf ppf "compare_floats"
+  | Pcompare_bints bi -> fprintf ppf "compare_bints %s" (boxed_integer_name bi)
   | Poffsetint n -> fprintf ppf "%i+" n
   | Poffsetref n -> fprintf ppf "+:=%i"n
   | Pintoffloat -> fprintf ppf "int_of_float"
diff --git a/middle_end/semantics_of_primitives.ml b/middle_end/semantics_of_primitives.ml
index cc3d18ef94..71feafc94b 100644
--- a/middle_end/semantics_of_primitives.ml
+++ b/middle_end/semantics_of_primitives.ml
@@ -52,6 +52,8 @@ let for_primitive (prim : Clambda_primitives.primitive) =
   | Plsrint
   | Pasrint
   | Pintcomp _ -> No_effects, No_coeffects
+  | Pcompare_ints | Pcompare_floats | Pcompare_bints _
+    -> No_effects, No_coeffects
   | Pdivbint { is_safe = Unsafe }
   | Pmodbint { is_safe = Unsafe }
   | Pdivint Unsafe