2 changed files with 98 additions and 0 deletions
@ -0,0 +1,98 @@
|
||||
(* ============================================ |
||||
Boolean circuits |
||||
============================================ *) |
||||
|
||||
(* _________ Types _________ *) |
||||
|
||||
type var = string |
||||
type id = int |
||||
|
||||
type op = |
||||
| CIn of int | COut | CShare |
||||
| CAnd | COr | CNeg |
||||
|
||||
type input = id |
||||
type gate = input list * op * id |
||||
type circuit = gate list |
||||
|
||||
(* _________ Getters _________ *) |
||||
|
||||
let get_node_info circ node = |
||||
let (ins, op, i) = |
||||
List.hd (List.filter (fun (_, _, i) -> i = node) circ) |
||||
in (ins, op) |
||||
|
||||
let get_inputs circ node = |
||||
let (ins, _) = get_node_info circ node in ins |
||||
|
||||
let get_op circ node = |
||||
let (_, op) = get_node_info circ node in op |
||||
|
||||
let extract_bin_ins = function |
||||
| [] -> failwith "Error extract_bin_ins: no input." |
||||
| h1::h2::t -> (h1, h2) |
||||
| _ -> failwith "Error extract_bin_ins: inputs does not match." |
||||
|
||||
(* _________ Evaluation _________ *) |
||||
|
||||
(* provides the boolean value of the node 'concl' in a circuit 'circ' *) |
||||
let rec value circ concl = |
||||
match get_op circ concl with |
||||
| CIn i -> i |
||||
| CShare | COut -> |
||||
let x = List.hd (get_inputs circ concl) in |
||||
value circ x |
||||
| CAnd -> |
||||
let (x, y) = extract_bin_ins (get_inputs circ concl) in |
||||
let vx = value circ x in |
||||
let vy = value circ y in |
||||
min vx vy |
||||
| COr -> |
||||
let (x, y) = extract_bin_ins (get_inputs circ concl) in |
||||
let vx = value circ x in |
||||
let vy = value circ y in |
||||
max vx vy |
||||
| CNeg -> |
||||
let x = List.hd (get_inputs circ concl) in |
||||
let vx = value circ x in |
||||
1 - vx |
||||
| _ -> -1 |
||||
|
||||
let rec eval (circ : circuit) : int = |
||||
let (_, _, concl) = |
||||
List.hd (List.filter (fun (_, o, _) -> o = COut) circ) in |
||||
value circ concl |
||||
|
||||
(* _________ Examples _________ *) |
||||
|
||||
let make_gate ins op id = (ins, op, id) |
||||
let make_input value id = ([], CIn value, id) |
||||
|
||||
let make_and_circ x y = [ |
||||
make_input x 0; |
||||
make_input y 1; |
||||
make_gate [0;1] CAnd 2; |
||||
make_gate [2] COut 3 |
||||
] |
||||
|
||||
let make_or_circ x y = [ |
||||
make_input x 0; |
||||
make_input y 1; |
||||
make_gate [0;1] COr 2; |
||||
make_gate [2] COut 3 |
||||
] |
||||
|
||||
let make_neg_circ x = [ |
||||
make_input x 0; |
||||
make_gate [0] CNeg 1; |
||||
make_gate [1] COut 2 |
||||
] |
||||
|
||||
(* corresponds to the excluded middle x v ~x *) |
||||
let make_em_circ x = [ |
||||
make_input x 0; |
||||
make_gate [0] CShare 1; |
||||
make_gate [1] CNeg 2; |
||||
make_gate [1;2] COr 3; |
||||
make_gate [3] COut 4 |
||||
] |
Loading…
Reference in new issue