You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
61 lines
2.3 KiB
61 lines
2.3 KiB
(*open Circuits |
|
open Resolution |
|
*) |
|
(* ============================================ |
|
Stellar Circuits |
|
============================================ *) |
|
|
|
let port pol i v = Func ("c"^(string_of_int i), pol, v) |
|
let inport i x = port Neg i [Var x] |
|
let outport i x = port Pos i [Var x] |
|
|
|
let call_cneg pol arg res = Func ("neg", pol, [arg; res]) |
|
let call_cand pol arg1 arg2 res = Func ("and", pol, [arg1; arg2; res]) |
|
let call_cor pol arg1 arg2 res = Func ("or", pol, [arg1; arg2; res]) |
|
|
|
let star_of_gate circ (ins, op, outs) = |
|
match op with |
|
| CIn i -> [port Pos (List.hd outs) [make_const (string_of_int i)]] |
|
| COut -> [inport (List.hd ins) "r"; Var "r"] |
|
| CShare -> |
|
let (o1, o2) = twinhd outs in |
|
[inport (List.hd ins) "x"; outport o1 "x"; outport o2 "x"] |
|
| CNeg -> [ |
|
inport (List.hd ins) "x"; |
|
call_cneg Neg (Var "x") (Var "r"); |
|
outport (List.hd outs) "r" |
|
] |
|
| CAnd -> |
|
let (i1, i2) = twinhd ins in [ |
|
inport i1 "x"; |
|
inport i2 "y"; |
|
call_cand Neg (Var "x") (Var "y") (Var "r"); |
|
outport (List.hd outs) "r" |
|
] |
|
| COr -> |
|
let (i1, i2) = twinhd ins in [ |
|
inport i1 "x"; |
|
inport i2 "y"; |
|
call_cor Neg (Var "x") (Var "y") (Var "r"); |
|
outport (List.hd outs) "r" |
|
] |
|
|
|
let const_of_circuit (circ : circuit) = List.map (star_of_gate circ) circ |
|
|
|
let prop_logic : constellation = [ |
|
[call_cneg Pos (make_const "0") (make_const "1")]; |
|
[call_cneg Pos (make_const "1") (make_const "0")]; |
|
[call_cand Pos (make_const "0") (make_const "0") (make_const "0")]; |
|
[call_cand Pos (make_const "0") (make_const "1") (make_const "0")]; |
|
[call_cand Pos (make_const "1") (make_const "0") (make_const "0")]; |
|
[call_cand Pos (make_const "1") (make_const "1") (make_const "1")]; |
|
[call_cor Pos (make_const "0") (make_const "0") (make_const "0")]; |
|
[call_cor Pos (make_const "0") (make_const "1") (make_const "1")]; |
|
[call_cor Pos (make_const "1") (make_const "0") (make_const "1")]; |
|
[call_cor Pos (make_const "1") (make_const "1") (make_const "1")] |
|
] |
|
|
|
let test2 = (const_of_circuit (make_em_circ 1));; |
|
let testprop = ((const_of_circuit (make_em_circ 1))@[[Func("or", Pos, [Func("0", Npol, []); Func("1", Npol, []); Func("1", Npol, [])])];[Func("neg",Pos, [Func("1", Npol, []); Func("0", Npol, [])])]]);; |
|
|
|
let extest2 = exec test2 [0];; |