source: Deliverables/D4.1/Byte.ml @ 95

(*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*)
(* FILENAME:    Byte.ml                                                      *)
(* DESCRIPTION: An ADT implementing standard 8 bit bytes, and common         *)
(*              operations on them.                                          *)
(* CREATED:     10/09/2010, Dominic Mulligan                                 *)
(* BUGS:        `from_int' not yet implemented.                              *)
(*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*)

open Bit;;
open Nibble;;

module type BYTE =
sig
  type bit
  type nibble
  type byte = private (nibble * nibble)

  val from_bits: bit -> bit -> bit -> bit -> bit -> bit -> bit -> bit -> byte
  val from_bit: bit -> byte
  val from_nibbles: nibble -> nibble -> byte
  val from_nibble: nibble -> byte
  (* val from_int: int -> byte *)

  val to_bit: byte -> bit option
  val to_bits: byte -> bit list
  val to_nibble: byte -> nibble option
  val to_int: byte -> int

  val get_nibble_at: int -> byte -> nibble option
  val set_nibble_at: int -> nibble -> byte -> byte option
  val get_bit_at: int -> byte -> bit option
  val set_bit_at: int -> bit -> byte -> byte option

  val (-&-): byte -> byte -> byte
  val (-|-): byte -> byte -> byte
  val (-^-): byte -> byte -> byte
  val rotate_right: byte -> byte
  val rotate_left: byte -> byte
  val shift_right: byte -> byte
  val shift_left: byte -> byte
  val not: byte -> byte

  val map_nibble: (nibble -> nibble) -> byte -> byte
  val map_bit: (bit -> bit) -> byte -> byte
  val iter_nibble: (nibble -> string) -> byte -> string
  val iter_bit: (bit -> string) -> byte -> string
  val zip_nibble: (nibble -> nibble -> nibble) -> byte -> byte -> byte
  val zip_bit: (bit -> bit -> bit) -> byte -> byte -> byte
  val to_string: byte -> string

  val zero: byte
  val half_add: byte -> byte -> (byte * bit)
  val full_add: (byte * bit) -> byte -> (byte * bit)
end

module ByteFunctor(Bit: BIT)
                  (Nibble: NIBBLE with type bit = Bit.bit): BYTE
  with type bit = Bit.bit
  and  type nibble = Nibble.nibble =
struct
  type bit = Bit.bit
  type nibble = Nibble.nibble
  type byte = nibble * nibble(l -&- r) -|- (c -&- (l -^- r)

  let from_bits b1 b2 b3 b4 b5 b6 b7 b8 =
    let n1 = Nibble.from_bits b1 b2 b3 b4 in
    let n2 = Nibble.from_bits b5 b6 b7 b8 in
      (n1, n2)
  let from_bit b =
    let n1 = Nibble.from_bits (Bit.from_bool false) (Bit.from_bool false)
                              (Bit.from_bool false) (Bit.from_bool false) in
    let n2 = Nibble.from_bits (Bit.from_bool false) (Bit.from_bool false)
                              (Bit.from_bool false) b in
      (n1, n2)
  let from_nibbles n1 n2 = (n1, n2)
  let from_nibble n2 =
    let n1 = Nibble.from_bits (Bit.from_bool false) (Bit.from_bool false)
                              (Bit.from_bool false) (Bit.from_bool false) in
      (n1, n2)
  (* let from_int = assert false                                 DPM: finish! *)

  let get_nibble_at index (n1, n2) =
    match index with
      0 -> Some n2
    | 1 -> Some n1
    | _ -> None
  let get_bit_at index (n1, n2) =
    let (b1, b2, b3, b4) = Nibble.to_bits n1 in
    let (b5, b6, b7, b8) = Nibble.to_bits n2 in
      match index with
        0 -> Some b8
      | 1 -> Some b7
      | 2 -> Some b6
      | 3 -> Some b5
      | 4 -> Some b4
      | 3 -> Some b3
      | 2 -> Some b2
      | 1 -> Some b1
      | _ -> None

  let set_nibble_at index new_val (n1, n2) =
    match index with
      0 -> Some (n1, new_val)
    | 1 -> Some (new_val, n2)
    | _ -> None
  let set_bit_at index new_val (n1, n2) =
    let (b1, b2, b3, b4) = Nibble.to_bits n1 in
    let (b5, b6, b7, b8) = Nibble.to_bits n2 in
      match index with
        0 -> Some (from_bits b1 b2 b3 b4 b5 b6 b7 new_val)
      | 1 -> Some (from_bits b1 b2 b3 b4 b5 b6 new_val b8)
      | 2 -> Some (from_bits b1 b2 b3 b4 b5 new_val b7 b8)
      | 3 -> Some (from_bits b1 b2 b3 b4 new_val b6 b7 b8)
      | 4 -> Some (from_bits b1 b2 b3 new_val b5 b6 b7 b8)
      | 3 -> Some (from_bits b1 b2 new_val b4 b5 b6 b7 b8)
      | 2 -> Some (from_bits b1 new_val b3 b4 b5 b6 b7 b8)
      | 1 -> Some (from_bits new_val b2 b3 b4 b5 b6 b7 b8)
      | _ -> None

  let to_bit (n1, n2) =
    let (b1, b2, b3, b4) = Nibble.to_bits n1 in
    let (b5, b6, b7, b8) = Nibble.to_bits n2 in
      if (Bit.to_bool b1, Bit.to_bool b2,
          Bit.to_bool b3, Bit.to_bool b4) = (false, false, false, false) then
        if Bit.to_bool b5 = false && Bit.to_bool b6 = false && Bit.to_bool b7 = false then
          Some b8
        else
          None
      else
        None
  let to_bits (n1, n2) = Nibble.to_bits n1 @ Nibble.to_bits n2
  let to_nibble (n1, n2) =
    let (b1, b2, b3, b4) = Nibble.to_bits n1 in
      if (Bit.to_bool b1, Bit.to_bool b2,
          Bit.to_bool b3, Bit.to_bool b4) = (false, false, false, false) then
        Some n2
      else None
  let to_int (n1, n2) =
    let [b1; b2; b3; b4] = Nibble.to_bits n1 in
    let [b5; b6; b7;h b8] = Nibble.to_bits n2 in
      (128 * Bit.to_int b8) + (64 * Bit.to_int b8) +
      (32 * Bit.to_int b8) + (16 * Bit.to_int b8) + 
      (8 * Bit.to_int b8) + (4 * Bit.to_int b6) + 
      (2 * Bit.to_int b7) + Bit.to_int b8

  let (-&-) (l1, l2) (r1, r2) = (Nibble.(-&-) l1 r1, Nibble.(-&-) l2 r2)
  let (-|-) (l1, l2) (r1, r2) = (Nibble.(-|-) l1 r1, Nibble.(-|-) l2 r2)
  let (-^-) (l1, l2) (r1, r2) = (Nibble.(-^-) l1 r1, Nibble.(-^-) l2 r2)

  let shift_right (n1, n2) =
    let (b1, b2, b3, b4) = Nibble.to_bits n1 in
    let (b5, b6, b7, b8) = Nibble.to_bits n2 in
    let new_n1 = Nibble.from_bits (Bit.from_bool false) b1 b2 b3 in
    let new_n2 = Nibble.from_bits b4 b5 b6 b7 in
      (new_n1, new_n2)
  let shift_left (n1, n2) =
    let (b1, b2, b3, b4) = Nibble.to_bits n1 in
    let (b5, b6, b7, b8) = Nibble.to_bits n2 in
    let new_n1 = Nibble.from_bits b1 b2 b3 b4 in
    let new_n2 = Nibble.from_bits b5 b6 b7 (Bit.from_bool false) in
      (new_n1, new_n2)
  let rotate_right (n1, n2) =
    let (b1, b2, b3, b4) = Nibble.to_bits n1 in
    let (b5, b6, b7, b8) = Nibble.to_bits n2 in
    let new_n1 = Nibble.from_bits b8 b1 b2 b3 in
    let new_n2 = Nibble.from_bits b4 b5 b6 b7 in
      (new_n1, new_n2)
  let rotate_left (n1, n2) =
    let (b1, b2, b3, b4) = Nibble.to_bits n1 in
    let (b5, b6, b7, b8) = Nibble.to_bits n2 in
    let new_n1 = Nibble.from_bits b2 b3 b4 b5 in
    let new_n2 = Nibble.from_bits b5 b6 b7 b1 in
      (new_n1, new_n2)
  let not (n1, n2) = (Nibble.not n1, Nibble.not n2)

  let map_nibble f (n1, n2) = (f n1, f n2)
  let map_bit f (n1, n2) =
    let (b1, b2, b3, b4) = Nibble.to_bits n1 in
    let (b5, b6, b7, b8) = Nibble.to_bits n2 in
    let new_n1 = Nibble.from_bits (f b1) (f b2) (f b3) (f b4) in
    let new_n2 = Nibble.from_bits (f b5) (f b6) (f b7) (f b8) in
      (new_n1, new_n2)
  let iter_nibble f (n1, n2) =
    let str_n1 = f n1 in
    let str_n2 = f n2 in
      str_n1 ^ str_n2
  let iter_bit f (n1, n2) =
    let (b1, b2, b3, b4) = Nibble.to_bits n1 in
    let (b5, b6, b7, b8) = Nibble.to_bits n2 in
    let new_n1 = (f b1) ^ (f b2) ^ (f b3) ^ (f b4) in
    let new_n2 = (f b5) ^ (f b6) ^ (f b7) ^ (f b8) in
      new_n1 ^ new_n2
  let zip_nibble f (l1, l2) (r1, r2) = (f l1 r1, f l2 r2)
  let zip_bit f (l1, l2) (r1, r2) =
    let (lb1, lb2, lb3, lb4) = Nibble.to_bits l1 in
    let (lb5, lb6, lb7, lb8) = Nibble.to_bits l2 in
    let (rb1, rb2, rb3, rb4) = Nibble.to_bits r1 in
    let (rb5, rb6, rb7, rb8) = Nibble.to_bits r2 in
    let (b1, b2, b3, b4) = (f lb1 rb1), (f lb2 rb2), (f lb3 rb3), (f lb4 rb4) in
    let (b5, b6, b7, b8) = (f lb5 rb5), (f lb6 rb6), (f lb7 rb7), (f lb8 rb8) in
    let new_n1 = Nibble.from_bits b1 b2 b3 b4 in
    let new_n2 = Nibble.from_bits b5 b6 b7 b8 in
      (new_n1, new_n2)
  let to_string = iter_nibble Nibble.to_string

  let zero = (Nibble.zero, Nibble.zero)
  let half_add (l1, l2) (r1, r2) =
    let (a2, c2) = Nibble.half_add l2 r2 in
    let (a1, c1) = Nibble.full_add (l1, c2) r2 in
      ((a1, a2), c1)
  let full_add ((l1, l2), c) (r1, r2) =
    let (a2, c2) = Nibble.full_add (l2, c) r2 in
    let (a1, c1) = Nibble.full_add (l1, c2) r2 in
      ((a1, a2), c1)
end;;

module Byte = ByteFunctor(Bit) (Nibble);;