open Core_kernel[@@warning "-D"]
open Regular.Std
open Bap_common_types


let memref ?(disp=0) ?(index=0) ?(scale=`r8)  addr =
  let n = Bap_size.in_bytes scale in
  let off = n * index + disp in
  Bap_bitvector.(addr ++ off)

module type Arith = sig
  include Integer
  val create : addr -> t Or_error.t
end

module type Core_int = sig
  include Int_intf.S
  val to_bv: t -> Bitvector.t
  val of_bv: Bitvector.t -> t Or_error.t
end


module Make(Int : Core_int) = struct
  open Or_error

* [ create_modulo_width x ] takes a number represented as a 
       [ n]-bits   , casts it to an int modulo [ n ] . 

       Since [ Int.t ] should be either [ int32 ] or [ int64 ] we can be sure 
       that number of bits is less then maximum number represantable by 
       OCaml 's [ int ] type . 
  
      [n]-bits length bitvector, casts it to an int modulo [n].

      Since [Int.t] should be either [int32] or [int64] we can be sure
      that number of bits is less then maximum number represantable by
      OCaml's [int] type.
  *)
  let to_int_modulo_width (x : Int.t) : int =
    let width = Int.num_bits in
    let x = Int.to_bv x in
    let w = Bitvector.of_int width ~width in
    match Bitvector.(Int_err.(!$x mod !$w) >>= to_int) with
    | Error _ -> assert false
    | Ok x -> x

  module Base = struct
    include Int
    let make f a off = f a (to_int_modulo_width off)
    let lshift  = make shift_left
    let rshift  = make shift_right_logical
    let arshift = make shift_right
    let modulo  = (%)
    let lnot    = bit_not
    let logand  = bit_and
    let logor   = bit_or
    let logxor  = bit_xor
    let div = ( / )
    let mul = ( * )
    let sub = ( - )
    let add = ( + )
  end

  let create = Int.of_bv
  include Integer.Make(Base)
end

module I32 = struct
  let of_bv x = Bitvector.to_int32 x
  let to_bv x = Bitvector.of_int32 x
  include Int32
end

module I64 = struct
  let of_bv x = Bitvector.to_int64 x
  let to_bv x = Bitvector.of_int64 x
  include Int64
end


module R32 = Make(I32)
module R64 = Make(I64)

open Core_kernel[@@warning "-D"]
open Regular.Std
open Bap_common_types


let memref ?(disp=0) ?(index=0) ?(scale=`r8)  addr =
  let n = Bap_size.in_bytes scale in
  let off = n * index + disp in
  Bap_bitvector.(addr ++ off)

module type Arith = sig
  include Integer
  val create : addr -> t Or_error.t
end

module type Core_int = sig
  include Int_intf.S
  val to_bv: t -> Bitvector.t
  val of_bv: Bitvector.t -> t Or_error.t
end


module Make(Int : Core_int) = struct
  open Or_error

* [ create_modulo_width x ] takes a number represented as a 
       [ n]-bits   , casts it to an int modulo [ n ] . 

       Since [ Int.t ] should be either [ int32 ] or [ int64 ] we can be sure 
       that number of bits is less then maximum number represantable by 
       OCaml 's [ int ] type . 
  
      [n]-bits length bitvector, casts it to an int modulo [n].

      Since [Int.t] should be either [int32] or [int64] we can be sure
      that number of bits is less then maximum number represantable by
      OCaml's [int] type.
  *)
  let to_int_modulo_width (x : Int.t) : int =
    let width = Int.num_bits in
    let x = Int.to_bv x in
    let w = Bitvector.of_int width ~width in
    match Bitvector.(Int_err.(!$x mod !$w) >>= to_int) with
    | Error _ -> assert false
    | Ok x -> x

  module Base = struct
    include Int
    let make f a off = f a (to_int_modulo_width off)
    let lshift  = make shift_left
    let rshift  = make shift_right_logical
    let arshift = make shift_right
    let modulo  = (%)
    let lnot    = bit_not
    let logand  = bit_and
    let logor   = bit_or
    let logxor  = bit_xor
    let div = ( / )
    let mul = ( * )
    let sub = ( - )
    let add = ( + )
  end

  let create = Int.of_bv
  include Integer.Make(Base)
end

module I32 = struct
  let of_bv x = Bitvector.to_int32 x
  let to_bv x = Bitvector.of_int32 x
  include Int32
end

module I64 = struct
  let of_bv x = Bitvector.to_int64 x
  let to_bv x = Bitvector.of_int64 x
  include Int64
end


module R32 = Make(I32)
module R64 = Make(I64)
