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