1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
|
(**************************************************************************)
(* *)
(* OCaml *)
(* *)
(* Pierre Chambart, OCamlPro *)
(* Mark Shinwell and Leo White, Jane Street Europe *)
(* *)
(* Copyright 2013--2016 OCamlPro SAS *)
(* Copyright 2014--2016 Jane Street Group LLC *)
(* *)
(* All rights reserved. This file is distributed under the terms of *)
(* the GNU Lesser General Public License version 2.1, with the *)
(* special exception on linking described in the file LICENSE. *)
(* *)
(**************************************************************************)
[@@@ocaml.warning "+a-4-9-30-40-41-42-66"]
open! Int_replace_polymorphic_compare
module A = Simple_value_approx
module C = Inlining_cost
external swap16 : int -> int = "%bswap16"
external swap32 : int32 -> int32 = "%bswap_int32"
external swap64 : int64 -> int64 = "%bswap_int64"
external swapnative : nativeint -> nativeint = "%bswap_native"
let const_int_expr expr n =
if Effect_analysis.no_effects_named expr then
let (new_expr, approx) = A.make_const_int_named n in
new_expr, approx, C.Benefit.remove_code_named expr C.Benefit.zero
else expr, A.value_int n, C.Benefit.zero
let const_char_expr expr c =
if Effect_analysis.no_effects_named expr then
let (new_expr, approx) = A.make_const_char_named c in
new_expr, approx, C.Benefit.remove_code_named expr C.Benefit.zero
else expr, A.value_char c, C.Benefit.zero
let const_bool_expr expr b =
const_int_expr expr (if b then 1 else 0)
let const_float_expr expr f =
if Effect_analysis.no_effects_named expr then
let (new_expr, approx) = A.make_const_float_named f in
new_expr, approx, C.Benefit.remove_code_named expr C.Benefit.zero
else expr, A.value_float f, C.Benefit.zero
let const_boxed_int_expr expr t i =
if Effect_analysis.no_effects_named expr then
let (new_expr, approx) = A.make_const_boxed_int_named t i in
new_expr, approx, C.Benefit.remove_code_named expr C.Benefit.zero
else expr, A.value_boxed_int t i, C.Benefit.zero
let const_integer_comparison_expr expr (cmp : Lambda.integer_comparison) x y =
(* Using the [Stdlib] comparison functions here in the compiler
coincides with the definitions of such functions in the code
compiled by the user, and is thus correct. *)
let open! Stdlib in
const_bool_expr expr
(match cmp with
| Ceq -> x = y
| Cne -> x <> y
| Clt -> x < y
| Cgt -> x > y
| Cle -> x <= y
| Cge -> x >= y)
let const_float_comparison_expr expr (cmp : Lambda.float_comparison) x y =
(* Using the [Stdlib] comparison functions here in the compiler
coincides with the definitions of such functions in the code
compiled by the user, and is thus correct. *)
let open! Stdlib in
const_bool_expr expr
(match cmp with
| CFeq -> x = y
| CFneq -> not (x = y)
| CFlt -> x < y
| CFnlt -> not (x < y)
| CFgt -> x > y
| CFngt -> not (x > y)
| CFle -> x <= y
| CFnle -> not (x <= y)
| CFge -> x >= y
| CFnge -> not (x >= y))
|
