balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Shell: introduce Compare.Uint{32,64}

Browse Source
This commit is contained in:
Grégoire Henry 2016-11-17 14:56:27 +01:00
parent 938ff6404b
commit c842140f74
4 changed files with 43 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
src/proto/bootstrap/script_int_repr.ml
View File

@ -141,23 +141,18 @@ let logsr _ (Int va) (Int vb) =
Int (Int64.shift_right_logical va (Int64.to_int vb))
(* sign aware comparison *)
let signed_compare va vb =
Compare.Int64.(if va = vb then 0 else if va > vb then 1 else -1)
let unsigned_compare va vb =
Compare.Int64.(if va >= 0L then if vb >= 0L then signed_compare va vb else -1
else if vb >= 0L then 1 else signed_compare va vb)
let compare
: type s l. (s, l) int_kind -> (s, l) int_val -> (s, l) int_val -> (signed, sixtyfour) int_val
= fun kind (Int va) (Int vb) ->
let cmp = match kind with
| Int8 -> signed_compare va vb
| Uint8 -> unsigned_compare va vb
| Int16 -> signed_compare va vb
| Uint16 -> unsigned_compare va vb
| Int32 -> signed_compare va vb
| Uint32 -> unsigned_compare va vb
| Int64 -> signed_compare va vb
| Uint64 -> unsigned_compare va vb in
| Int8 -> Compare.Int64.compare va vb
| Uint8 -> Compare.Uint64.compare va vb
| Int16 -> Compare.Int64.compare va vb
| Uint16 -> Compare.Uint64.compare va vb
| Int32 -> Compare.Int64.compare va vb
| Uint32 -> Compare.Uint64.compare va vb
| Int64 -> Compare.Int64.compare va vb
| Uint64 -> Compare.Uint64.compare va vb in
Int Compare.Int.(if cmp = 0 then 0L else if cmp > 0 then 1L else -1L)
let equal kind va vb =
@ -172,9 +167,9 @@ let checked_add : type s l. (s, l) int_kind -> (s, l) int_val -> (s, l) int_val
| Uint16 -> checked_of_int64 Uint16 r
| Int32 -> checked_of_int64 Int32 r
| Uint32 -> checked_of_int64 Uint32 r
| Int64 when Compare.Int.(signed_compare r va < 0) -> None
| Int64 when Compare.Int.(Compare.Int64.compare r va < 0) -> None
| Int64 -> Some (Int r)
| Uint64 when Compare.Int.(unsigned_compare r va < 0) -> None
| Uint64 when Compare.Int.(Compare.Uint64.compare r va < 0) -> None
| Uint64 -> Some (Int r)
let checked_sub : type s l. (s, l) int_kind -> (s, l) int_val -> (s, l) int_val -> (s, l) int_val option
@ -186,10 +181,10 @@ let checked_sub : type s l. (s, l) int_kind -> (s, l) int_val -> (s, l) int_val
| Int32 -> checked_of_int64 Int32 r
| Uint32 -> checked_of_int64 Uint32 r
| Int64 when Compare.Int64.(vb >= 0L) ->
if Compare.Int.(signed_compare r va <= 0) then Some (Int r) else None
if Compare.Int.(Compare.Int64.compare r va <= 0) then Some (Int r) else None
| Int64 ->
if Compare.Int.(signed_compare r va >= 0) then Some (Int r) else None
| Uint64 when Compare.Int.(unsigned_compare r va > 0) -> None
if Compare.Int.(Compare.Int64.compare r va >= 0) then Some (Int r) else None
| Uint64 when Compare.Int.(Compare.Uint64.compare r va > 0) -> None
| Uint64 -> Some (Int r)
let checked_neg : type l. (signed, l) int_kind -> (signed, l) int_val -> (signed, l) int_val option

2
src/proto/environment/compare.mli
View File

@ -16,7 +16,9 @@ module Char : S with type t = char
module Bool : S with type t = bool
module Int : S with type t = int
module Int32 : S with type t = int32
module Uint32 : S with type t = int32
module Int64 : S with type t = int64
module Uint64 : S with type t = int64
module Float : S with type t = float
module String : S with type t = string
module List(P : S) : S with type t = P.t list

26
src/utils/compare.ml
View File

@ -85,6 +85,32 @@ module Int64 = struct
let min x y = if x <= y then x else y
end
module MakeUnsigned(Int : S)(Z : sig val zero : Int.t end) = struct
type t = Int.t
let compare va vb =
Int.(if va >= Z.zero then if vb >= Z.zero then compare va vb else -1
else if vb >= Z.zero then 1 else compare va vb)
let (=) = ((=) : t -> t -> bool)
let (<>) = ((<>) : t -> t -> bool)
let (<) a b =
Int.(if Z.zero <= a then
(a < b || b < Z.zero)
else
(b < Z.zero && a < b))
let (<=) a b =
Int.(if Z.zero <= a then
(a <= b || b < Z.zero)
else
(b < Z.zero && a <= b))
let (>=) a b = (<=) b a
let (>) a b = (<) b a
let max x y = if x >= y then x else y
let min x y = if x <= y then x else y
end
module Uint32 = MakeUnsigned(Int32)(struct let zero = 0l end)
module Uint64 = MakeUnsigned(Int64)(struct let zero = 0L end)
module Float = struct
type t = float
let (=) = ((=) : t -> t -> bool)

2
src/utils/compare.mli
View File

@ -24,7 +24,9 @@ module Char : S with type t = char
module Bool : S with type t = bool
module Int : S with type t = int
module Int32 : S with type t = int32
module Uint32 : S with type t = int32
module Int64 : S with type t = int64
module Uint64 : S with type t = int64
module Float : S with type t = float
module String : S with type t = string
module List(P : S) : S with type t = P.t list