You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

112 lines
2.8 KiB

(*
* 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