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

Last change on this file since 93 was 85, checked in by mulligan, 10 years ago

Deleted Pretty.ml, as `pretty' functions have now been merged into
other files where they belong.
where

File size: 2.0 KB
Line 
1(*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*)
2(* FILENAME:    Bit.ml                                                       *)
3(* DESCRIPTION: An ADT implementing bits, and common operations on them.     *)
4(* CREATED:     10/09/2010, Dominic Mulligan                                 *)
5(* BUGS:                                                                     *)
6(*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*)
7
8module type BIT =
9sig
10  type bit = private bool (* DPM: Make abstract? *)
11
12  val from_bool: bool -> bit
13  val from_int: int -> bit
14  val from_string: string -> bit option
15
16  val to_bool: bit -> bool
17  val to_int: bit -> int
18  val to_string: bit -> string
19
20  val (-&-): bit -> bit -> bit
21  val (-|-): bit -> bit -> bit
22  val (-^-): bit -> bit -> bit
23  val not: bit -> bit
24
25  val zero: bit
26
27  (* Half add: two input bits, returns addition of bit plus carry. *)
28  val half_add: bit -> bit -> (bit * bit)
29  (* Full add: two input bits, plus input carry bit, returns       *)
30  (* addition of input bits plus carry.                            *)
31  val full_add: (bit * bit) -> bit -> (bit * bit)
32end;;
33
34module Bit: BIT =
35struct
36  type bit = bool
37
38  let from_bool b = b
39  let from_int i =
40    if i > 0 then
41      true
42    else
43      false
44  let from_string =
45    function
46      "0" -> Some false
47    | "1" -> Some true
48    | _ -> None
49
50  let to_int =
51    function
52      false -> 0
53    | true -> 1
54  let to_string l =
55    match l with
56      true -> "1"
57    | false -> "0"
58
59  let to_bool b = b
60
61  let (-&-) l r =
62    match l with
63      true -> r
64    | false -> false
65  let (-|-) l r =
66    match l with
67      true -> true
68    | false -> r
69  let (-^-) (l: bit) r =
70    match l with
71      true -> not r
72    | false -> r
73  let not l =
74    match l with
75      true -> false
76    | false -> true
77
78  let zero = false
79
80  let half_add l r = (l -^- r, l -&- r)
81  let full_add (l, c) r =
82    ((l -^- r) -^- c, (l -&- r) -|- (c -&- (l -^- r)))
83end;;
Note: See TracBrowser for help on using the repository browser.