diff --git a/lib/bap/bap.mli b/lib/bap/bap.mli index 5e72c1157..bae15b3d7 100644 --- a/lib/bap/bap.mli +++ b/lib/bap/bap.mli @@ -1235,9 +1235,33 @@ module Std : sig expected from integral values. *) include Integer.S with type t := t - (** A comparable interface with size-monomorphic comparison. *) + (** The comparable interface with size-monomorphic comparison. *) module Mono : Comparable with type t := t + + (** The comparable interface using the unsigned order. + + @since 2.5.0 *) + module Unsigned : sig + include Binable.S with type t = t + include Comparable.S_binable with type t := t + include Hashable.S_binable with type t := t + end + + (** The comparable interface using the literal order. + + In this order the bitvectors are compared literally, so that + bitvectors of different sizes but with equal values will be + different. This is the fastest order. + + @since 2.5.0 *) + module Literal : sig + include Binable.S with type t = t + include Comparable.S_binable with type t := t + include Hashable.S_binable with type t := t + end + + (** Specifies the order of bytes in a word. *) type endian = | LittleEndian (** least significant byte comes first *) diff --git a/lib/bap_types/bap_bitvector.ml b/lib/bap_types/bap_bitvector.ml index 8f5b7a179..109e87b83 100644 --- a/lib/bap_types/bap_bitvector.ml +++ b/lib/bap_types/bap_bitvector.ml @@ -157,7 +157,7 @@ let data_word t x = create x (Theory.Target.bits t) [@@inline] let to_bitvec x = Packed.payload x [@@inline] let unsigned x = x [@@inline] let signed x = Packed.signed x [@@inline] -let hash x = Packed.hash x [@@inline] +let hash x = Bitvec.hash (Packed.payload x) [@@inline] let bits_of_z x = Bitvec.to_binary (Packed.payload x) let unop op t = Packed.lift1 t op [@@inline] let binop op t1 t2 = Packed.lift2 t1 t2 op [@@inline] @@ -271,20 +271,26 @@ type packed = Packed.t [@@deriving bin_io] let sexp_of_packed = Sexp_hum.sexp_of_t let packed_of_sexp = Sexp_hum.t_of_sexp + +let compare_literal = Packed.compare + +let compare_unsigned x y = + Bitvec.compare (payload x) (payload y) +[@@inline] + let compare_signed x y = if phys_equal x y then 0 - else match Packed.compare x y with + else + match compare_literal x y with | 0 -> 0 - | r -> + | _ -> if is_signed x || is_signed y then let x_is_neg = msb x and y_is_neg = msb y in match x_is_neg, y_is_neg with | true,false -> -1 | false,true -> 1 - | _ -> Bitvec.compare (payload x) (payload y) - else r - - + | _ -> compare_unsigned x y + else compare_unsigned x y let with_validation t ~f = Or_error.map ~f (Validate.result t) @@ -628,6 +634,23 @@ module Trie = struct end end +module Literal = struct + type t = packed [@@deriving bin_io, sexp] + include Comparable.Make_binable(Packed) + include Hashable.Make_binable_and_derive_hash_fold_t(Packed) +end + +module Unsigned = struct + module Order = struct + type t = packed [@@deriving bin_io,sexp] + let compare = compare_unsigned + let hash = hash + end + include Comparable.Make_binable(Order) + include Hashable.Make_binable_and_derive_hash_fold_t(Order) + include Order +end + include Or_error.Monad_infix include Regular.Make(struct type t = packed [@@deriving bin_io, sexp] @@ -698,6 +721,7 @@ module Stable = struct end + let to_string = string_of_word let of_string = word_of_string diff --git a/lib/bap_types/bap_bitvector.mli b/lib/bap_types/bap_bitvector.mli index 27a9089f1..3fa9a9251 100644 --- a/lib/bap_types/bap_bitvector.mli +++ b/lib/bap_types/bap_bitvector.mli @@ -13,6 +13,16 @@ type endian = include Regular.S with type t := t include Bap_integer.S with type t := t module Mono : Comparable.S with type t := t +module Unsigned : sig + include Binable.S with type t = t + include Comparable.S_binable with type t := t + include Hashable.S_binable with type t := t +end +module Literal : sig + include Binable.S with type t = t + include Comparable.S_binable with type t := t + include Hashable.S_binable with type t := t +end val create : Bitvec.t -> int -> t