diff options
author | Greta Yorsh <45005955+gretay-js@users.noreply.github.com> | 2020-03-26 09:58:10 +0000 |
---|---|---|
committer | GitHub <noreply@github.com> | 2020-03-26 10:58:10 +0100 |
commit | 824ce3549211f9d72ca3c58362f088a4369ebc2e (patch) | |
tree | 3f8ff9b108e586a52e35422fcad82f06fb11d8a5 /middle_end | |
parent | bc3246c5289dc32841509f349f90a304170fc2cc (diff) | |
download | ocaml-824ce3549211f9d72ca3c58362f088a4369ebc2e.tar.gz |
Replace caml_int_compare and caml_float_compare with primitives (#2324)
Diffstat (limited to 'middle_end')
-rw-r--r-- | middle_end/clambda_primitives.ml | 1 | ||||
-rw-r--r-- | middle_end/clambda_primitives.mli | 1 | ||||
-rw-r--r-- | middle_end/convert_primitives.ml | 3 | ||||
-rw-r--r-- | middle_end/flambda/simplify_boxed_integer_ops.ml | 2 | ||||
-rw-r--r-- | middle_end/flambda/simplify_primitives.ml | 5 | ||||
-rw-r--r-- | middle_end/internal_variable_names.ml | 12 | ||||
-rw-r--r-- | middle_end/printclambda_primitives.ml | 3 | ||||
-rw-r--r-- | middle_end/semantics_of_primitives.ml | 2 |
8 files changed, 28 insertions, 1 deletions
diff --git a/middle_end/clambda_primitives.ml b/middle_end/clambda_primitives.ml index a7c9798f36..3dd0587972 100644 --- a/middle_end/clambda_primitives.ml +++ b/middle_end/clambda_primitives.ml @@ -53,6 +53,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 d534ca9cfa..a75cd04814 100644 --- a/middle_end/clambda_primitives.mli +++ b/middle_end/clambda_primitives.mli @@ -53,6 +53,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 17d17ea8af..4ea177393e 100644 --- a/middle_end/convert_primitives.ml +++ b/middle_end/convert_primitives.ml @@ -54,6 +54,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 b87e73f74f..cc3102ec5f 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" @@ -222,6 +225,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" @@ -337,6 +343,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 @@ -440,6 +449,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 3f627063d4..2e94989155 100644 --- a/middle_end/printclambda_primitives.ml +++ b/middle_end/printclambda_primitives.ml @@ -120,6 +120,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 2daf167ecd..47ed8c3e59 100644 --- a/middle_end/semantics_of_primitives.ml +++ b/middle_end/semantics_of_primitives.ml @@ -47,6 +47,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 |