|
|
|
(*
|
|
|
|
* Copyright (c) 2009 - 2013 Monoidics ltd.
|
|
|
|
* Copyright (c) 2013 - present Facebook, Inc.
|
|
|
|
* All rights reserved.
|
|
|
|
*
|
|
|
|
* This source code is licensed under the BSD style license found in the
|
|
|
|
* LICENSE file in the root directory of this source tree. An additional grant
|
|
|
|
* of patent rights can be found in the PATENTS file in the same directory.
|
|
|
|
*)
|
|
|
|
open! IStd
|
|
|
|
module F = Format
|
|
|
|
|
|
|
|
(** signed and unsigned integer literals *)
|
|
|
|
type t = bool * Int64.t * bool
|
|
|
|
|
|
|
|
(* the first bool indicates whether this is an unsigned value,
|
|
|
|
and the second whether it is a pointer *)
|
|
|
|
|
|
|
|
let area u i =
|
|
|
|
match (i < 0L, u) with
|
|
|
|
| true, false
|
|
|
|
-> (* only representable as signed *) 1
|
|
|
|
| false, _
|
|
|
|
-> (* in the intersection between signed and unsigned *) 2
|
|
|
|
| true, true
|
|
|
|
-> (* only representable as unsigned *) 3
|
|
|
|
|
|
|
|
let to_signed (unsigned, i, ptr) =
|
|
|
|
if Int.equal (area unsigned i) 3 then None
|
|
|
|
else (* not representable as signed *) Some (false, i, ptr)
|
|
|
|
|
|
|
|
let compare (unsigned1, i1, _) (unsigned2, i2, _) =
|
|
|
|
let n = Bool.compare unsigned1 unsigned2 in
|
|
|
|
if n <> 0 then n else Int64.compare i1 i2
|
|
|
|
|
|
|
|
let compare_value (unsigned1, i1, _) (unsigned2, i2, _) =
|
|
|
|
[%compare : int * Int64.t] (area unsigned1 i1, i1) (area unsigned2 i2, i2)
|
|
|
|
|
|
|
|
let eq i1 i2 = Int.equal (compare_value i1 i2) 0
|
|
|
|
|
|
|
|
let neq i1 i2 = compare_value i1 i2 <> 0
|
|
|
|
|
|
|
|
let leq i1 i2 = compare_value i1 i2 <= 0
|
|
|
|
|
|
|
|
let lt i1 i2 = compare_value i1 i2 < 0
|
|
|
|
|
|
|
|
let geq i1 i2 = compare_value i1 i2 >= 0
|
|
|
|
|
|
|
|
let gt i1 i2 = compare_value i1 i2 > 0
|
|
|
|
|
|
|
|
let of_int64 i = (false, i, false)
|
|
|
|
|
|
|
|
let of_int32 i = of_int64 (Int64.of_int32 i)
|
|
|
|
|
|
|
|
let of_int64_unsigned i unsigned = (unsigned, i, false)
|
|
|
|
|
|
|
|
let of_int i = of_int64 (Int64.of_int i)
|
|
|
|
|
|
|
|
let to_int (_, i, _) = Int64.to_int_exn i
|
|
|
|
|
|
|
|
let null = (false, 0L, true)
|
|
|
|
|
|
|
|
let zero = of_int 0
|
|
|
|
|
|
|
|
let one = of_int 1
|
|
|
|
|
|
|
|
let two = of_int 2
|
|
|
|
|
|
|
|
let minus_one = of_int (-1)
|
|
|
|
|
|
|
|
let isone (_, i, _) = Int64.equal i 1L
|
|
|
|
|
|
|
|
let iszero (_, i, _) = Int64.equal i 0L
|
|
|
|
|
|
|
|
let isnull (_, i, ptr) = Int64.equal i 0L && ptr
|
|
|
|
|
|
|
|
let isminusone (unsigned, i, _) = not unsigned && Int64.equal i (-1L)
|
|
|
|
|
|
|
|
let isnegative (unsigned, i, _) = not unsigned && i < 0L
|
|
|
|
|
|
|
|
let neg (unsigned, i, ptr) = (unsigned, Int64.neg i, ptr)
|
|
|
|
|
|
|
|
let lift binop (unsigned1, i1, ptr1) (unsigned2, i2, ptr2) =
|
|
|
|
(unsigned1 || unsigned2, binop i1 i2, ptr1 || ptr2)
|
|
|
|
|
|
|
|
let lift1 unop (unsigned, i, ptr) = (unsigned, unop i, ptr)
|
|
|
|
|
|
|
|
let add i1 i2 = lift Int64.( + ) i1 i2
|
|
|
|
|
|
|
|
let mul i1 i2 = lift Int64.( * ) i1 i2
|
|
|
|
|
|
|
|
let div i1 i2 = lift Int64.( / ) i1 i2
|
|
|
|
|
|
|
|
let rem i1 i2 = lift Int64.rem i1 i2
|
|
|
|
|
|
|
|
let logand i1 i2 = lift Int64.bit_and i1 i2
|
|
|
|
|
|
|
|
let logor i1 i2 = lift Int64.bit_or i1 i2
|
|
|
|
|
|
|
|
let logxor i1 i2 = lift Int64.bit_xor i1 i2
|
|
|
|
|
|
|
|
let lognot i = lift1 Int64.bit_not i
|
|
|
|
|
|
|
|
let sub i1 i2 = add i1 (neg i2)
|
|
|
|
|
|
|
|
let pp f (unsigned, n, ptr) =
|
|
|
|
if ptr && Int64.equal n 0L then F.fprintf f "null"
|
|
|
|
else if unsigned then F.fprintf f "%Lu" n
|
|
|
|
else F.fprintf f "%Ld" n
|
|
|
|
|
|
|
|
let to_string i = F.asprintf "%a" pp i
|