source: Deliverables/D4.1/Byte7.ml @ 86

(*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*)
(* FILENAME:    Byte7.ml                                                     *)
(* DESCRIPTION: An ADT implementing non-standard 7 bit bytes, and common     *)
(*              operations on them.                                          *)
(* CREATED:     13/09/2010, Dominic Mulligan                                 *)
(* BUGS:                                                                     *)
(*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*)

open Bit;;
open Nibble;;

module type BYTE7 =
sig
  type bit
  type nibble
  type byte7 = private (bit * bit * bit * nibble)

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

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

  val iter_bit: (bit -> string) -> byte7 -> string
  val map_bit: (bit -> bit) -> byte7 -> byte7
  val zip_bit: (bit -> bit -> bit) -> byte7 -> byte7 -> byte7
  val to_string: byte7 -> string
end;;

module Byte7Functor(Bit: BIT)
                   (Nibble: NIBBLE
                      with type bit = Bit.bit): BYTE7
  with type bit    = Bit.bit
  and  type nibble = Nibble.nibble =
struct
  type bit = Bit.bit
  type nibble = Nibble.nibble
  type byte7 = bit * bit * bit * nibble

  let get_bit_at index (b1,b2,b3,b) =
    if index < 4 then
      Nibble.get_bit_at index b
    else
      match index with
        4 -> Some b3
      | 5 -> Some b2
      | 6 -> Some b1
      | _ -> None
  let set_bit_at index new_val (b1,b2,b3,b) =
    if index < 4 then
      let nib = Nibble.set_bit_at index new_val b in
        match nib with
          Some nib -> Some (b1, b2, b3, nib)
        | None -> None
    else
      match index with
        4 -> Some (b3, b2, new_val, b)
      | 5 -> Some (b3, new_val, b1, b)
      | 6 -> Some (new_val, b2, b1, b)
      | _ -> None

  let (-&-) (l1, l2, l3, l) (r1, r2, r3, r) =
    (Bit.(-&-) l1 r1, Bit.(-&-) l2 r2, Bit.(-&-) l3 r3, Nibble.(-&-) l r)
  let (-|-) (l1, l2, l3, l) (r1, r2, r3, r) =
    (Bit.(-|-) l1 r1, Bit.(-|-) l2 r2, Bit.(-|-) l3 r3, Nibble.(-|-) l r)
  let (-^-) (l1, l2, l3, l) (r1, r2, r3, r) =
    (Bit.(-^-) l1 r1, Bit.(-^-) l2 r2, Bit.(-^-) l3 r3, Nibble.(-^-) l r)
  let not (b1, b2, b3, b) = (Bit.not b1, Bit.not b2, Bit.not b3, Nibble.not b)

  let iter_bit f (b1, b2, b3, b) =
    let n_bits = f b1 ^ f b2 ^ f b3 in
    let n_byte = Nibble.iter_bit f b in
      n_bits ^ n_byte
  let map_bit f (b1, b2, b3, b) =
    (f b1, f b2, f b3, Nibble.map_bit f b)
  let zip_bit f (l1, l2, l3, l) (r1, r2, r3, r) =
    (f l1 r1, f l2 r2, f l3 r3, Nibble.zip_bit f l r)

  let to_string = iter_bit Bit.to_string
end;;

module Byte7 = Byte7Functor (Bit) (Nibble);;