source: Deliverables/D4.1/Nibble.ml @ 63

(*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*)
(* FILENAME:    Nibble.ml                                                    *)
(* DESCRIPTION: An ADT implementing 4 bit nibbles, and common operations on  *)
(*              them.                                                        *)
(* CREATED:     10/09/2010, Dominic Mulligan                                 *)
(* BUGS:                                                                     *)
(*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*)

open Bit;;

module type NIBBLE =
sig
  type bit
  type nibble

  val from_bits: bit -> bit -> bit -> bit -> nibble
  val from_bit: bit -> nibble
  val from_int: int -> nibble option
  val from_string: string -> nibble option

  val to_bits: nibble -> (bit * bit * bit * bit)
  val to_bit: nibble -> bit option
  val to_int: nibble -> int
  val to_string: nibble -> string

  val get_bit_at: int -> nibble -> bit option
  val set_bit_at: int -> bit -> nibble -> nibble option

  val (-&-): nibble -> nibble -> nibble
  val (-|-): nibble -> nibble -> nibble
  val (-^-): nibble -> nibble -> nibble
  val not: nibble -> nibble

  val swap_bits: nibble -> nibble

  val map_bit: (bit -> bit) -> nibble -> nibble
  val iter_bit: (bit -> string) -> nibble -> string
  val zip_bit: (bit -> bit -> bit) -> nibble -> nibble -> nibble
end

module NibbleFunctor(Bit: BIT) : NIBBLE with type bit = Bit.bit =
struct
  type bit = Bit.bit
  type nibble = bit * bit * bit * bit

  let from_bits b1 b2 b3 b4 = (b1, b2, b3, b4)
  let from_bit h = (Bit.from_bool false, Bit.from_bool false, Bit.from_bool false, h)
  let from_int int_val =
    match int_val with
      0 -> Some (Bit.from_int 0, Bit.from_int 0, Bit.from_int 0, Bit.from_int 0)
    | 1 -> Some (Bit.from_int 0, Bit.from_int 0, Bit.from_int 0, Bit.from_int 1)
    | 2 -> Some (Bit.from_int 0, Bit.from_int 0, Bit.from_int 1, Bit.from_int 0)
    | 3 -> Some (Bit.from_int 0, Bit.from_int 0, Bit.from_int 1, Bit.from_int 1)
    | 4 -> Some (Bit.from_int 0, Bit.from_int 1, Bit.from_int 0, Bit.from_int 0)
    | 5 -> Some (Bit.from_int 0, Bit.from_int 1, Bit.from_int 0, Bit.from_int 1)
    | 6 -> Some (Bit.from_int 0, Bit.from_int 1, Bit.from_int 1, Bit.from_int 0)
    | 7 -> Some (Bit.from_int 0, Bit.from_int 1, Bit.from_int 1, Bit.from_int 1)
    | 8 -> Some (Bit.from_int 1, Bit.from_int 0, Bit.from_int 0, Bit.from_int 0)
    | 9 -> Some (Bit.from_int 1, Bit.from_int 0, Bit.from_int 0, Bit.from_int 1)
    | 10 -> Some (Bit.from_int 1, Bit.from_int 0, Bit.from_int 1, Bit.from_int 0)
    | 11 -> Some (Bit.from_int 1, Bit.from_int 0, Bit.from_int 1, Bit.from_int 1)
    | 12 -> Some (Bit.from_int 1, Bit.from_int 1, Bit.from_int 0, Bit.from_int 0)
    | 13 -> Some (Bit.from_int 1, Bit.from_int 1, Bit.from_int 0, Bit.from_int 1)
    | 14 -> Some (Bit.from_int 1, Bit.from_int 1, Bit.from_int 1, Bit.from_int 0)
    | 15 -> Some (Bit.from_int 1, Bit.from_int 1, Bit.from_int 1, Bit.from_int 1)
    | _ -> None
  let from_string

  let to_bit (l, h) =
    let (bl, bh) = Bit.to_bool l, Bit.to_bool h in
    match (bl, bh) with
      (false, b) -> Some (Bit.from_bool b)
    | (true, b) -> None
  let to_int (l, h) = (2 * Bit.to_int l) + Bit.to_int h
  let to_string = iter_bit Bit.to_string

  let get_bit_at index (l, h) =
    if index = 0 then
      Some l
    else if index = 1 then
      Some h
    else
      None

  let set_bit_at index new_bit (l, h) =
    if index = 0 then
      Some (new_bit, h)
    else if index = 1 then
      Some (l, new_bit)
    else
      None

  let (-&-) (l1,h1) (l2, h2) =
     (Bit.(-&-) l1 l2, Bit.(-&-) h1 h2)
  let (-|-) (l1,h1) (l2, h2) =
     (Bit.(-|-) l1 l2, Bit.(-|-) h1 h2)
  let (-^-) (l1,h1) (l2, h2) =
     (Bit.(-^-) l1 l2, Bit.(-^-) h1 h2)

  let not (l, h) = (Bit.not l, Bit.not h)

  let swap_bits (l, h) = (h, l)

  let map_bit f (l, h) = (f l, f h)
  let iter_bit f (l, h) =
    let str_l = f l in
    let str_h = f h in
      str_l ^ str_h
  let zip_bit f (l1, h1) (l2, h2) = (f l1 l2, f l2 h2)
end

module Nibble = NibbleFunctor(Bit)