src/concrete/concrete_i64.ml

 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
82
83
84
85
86
87
88
89
90
91

include Int64

type t = int64

let extend_i32_s x = Int64.of_int32 x

let extend_i32_u x = Int64.logand (Int64.of_int32 x) 0x0000_0000_ffff_ffffL

let trunc_f32_s x =
  if Float32.ne x x then Error `Conversion_to_integer
  else if
    let mif = Int64.(to_float min_int) in
    Float32.(ge x @@ of_float @@ ~-.mif) || Float32.(lt x @@ of_float mif)
  then Error `Integer_overflow
  else Ok (Int64.of_float @@ Float32.to_float x)

let trunc_f32_u x =
  let mif = Int64.(to_float min_int) in
  if Float32.ne x x then Error `Conversion_to_integer
  else if
    Float32.(ge x @@ of_float ~-.(mif *. 2.0))
    || Float32.(le x @@ of_float ~-.1.0)
  then Error `Integer_overflow
  else if Float32.(ge x @@ of_float ~-.mif) then
    Ok Int64.(logxor (of_float (Float32.to_float x -. 0x1p63)) min_int)
  else Ok (Int64.of_float @@ Float32.to_float x)

let trunc_f64_s x =
  if Float64.ne x x then Error `Conversion_to_integer
  else if
    let mif = Int64.(to_float min_int) in
    Float64.(ge x @@ of_float ~-.mif) || Float64.(lt x @@ of_float mif)
  then Error `Integer_overflow
  else Ok (Int64.of_float @@ Float64.to_float x)

let trunc_f64_u x =
  let mif = Int64.(to_float min_int) in
  if Float64.ne x x then Error `Conversion_to_integer
  else if
    Float64.(ge x @@ of_float (~-.mif *. 2.0))
    || Float64.(le x @@ of_float ~-.1.0)
  then Error `Integer_overflow
  else if Float64.(ge x @@ of_float ~-.mif) then
    Ok Int64.(logxor (of_float (Float64.to_float x -. 0x1p63)) min_int)
  else Ok (Int64.of_float @@ Float64.to_float x)

let trunc_sat_f32_s x =
  if Float32.ne x x then 0L
  else
    let mif = Int64.(to_float min_int) in
    if Float32.(lt x @@ of_float mif) then Int64.min_int
    else if Float32.(ge x @@ of_float ~-.mif) then Int64.max_int
    else Int64.of_float (Float32.to_float x)

let trunc_sat_f32_u x =
  if Float32.ne x x then 0L
  else
    let mif = Int64.(to_float min_int) in
    if Float32.(le x @@ of_float ~-.1.0) then 0L
    else if Float32.(ge x @@ of_float (~-.mif *. 2.0)) then -1L
    else if Float32.(ge x @@ of_float ~-.mif) then
      Int64.(
        logxor (of_float (Float32.to_float x -. 9223372036854775808.0)) min_int )
    else Int64.of_float @@ Float32.to_float x

let trunc_sat_f64_s x =
  if Float64.ne x x then 0L
  else
    let mif = Int64.(to_float min_int) in
    if Float64.(lt x @@ of_float mif) then Int64.min_int
    else if Float64.(ge x @@ of_float ~-.mif) then Int64.max_int
    else Int64.of_float @@ Float64.to_float x

let trunc_sat_f64_u x =
  if Float64.ne x x then 0L
  else
    let mif = Int64.(to_float min_int) in
    if Float64.(le x @@ of_float ~-.1.0) then 0L
    else if Float64.(ge x @@ of_float @@ (~-.mif *. 2.0)) then -1L
    else if Float64.(ge x @@ of_float ~-.mif) then
      Int64.(
        logxor (of_float (Float64.to_float x -. 9223372036854775808.0)) min_int )
    else Int64.of_float @@ Float64.to_float x

let reinterpret_f64 = Float64.to_bits

let of_concrete v = v

let eq_concrete = eq

let pp = Fmt.int64