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