source: Deliverables/D4.1/Bit.ml @ 83

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

module type BIT =
sig
  type bit

  val from_bool: bool -> bit
  val from_int: int -> bit
  val from_string: string -> bit option

  val to_bool: bit -> bool
  val to_int: bit -> int
  val to_string: bit -> string

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

  val zero: bit

  (* Half add: two input bits, returns addition of bit plus carry. *)
  val half_add: bit -> bit -> (bit * bit)
  (* Full add: two input bits, plus input carry bit, returns       *)
  (* addition of input bits plus carry.                            *)
  val full_add: (bit * bit) -> bit -> (bit * bit)
end;;

module Bit: BIT =
struct
  type bit = bool

  let from_bool b = b
  let from_int i =
    if i > 0 then
      true
    else
      false
  let from_string =
    function
      "0" -> Some false
    | "1" -> Some true
    | _ -> None

  let to_int =
    function
      false -> 0
    | true -> 1
  let to_string l =
    match l with
      true -> "1"
    | false -> "0"

  let to_bool b = b

  let (-&-) l r =
    match l with
      true -> r
    | false -> false
  let (-|-) l r =
    match l with
      true -> true
    | false -> r
  let (-^-) (l: bit) r =
    match l with
      true -> not r
    | false -> r
  let not l =
    match l with
      true -> false
    | false -> true

  let zero = false

  let half_add l r = (l -^- r, l -&- r)
  let full_add (l, c) r =
    ((l -^- r) -^- c, (l -&- r) -|- (c -&- (l -^- r)))
end;;