{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-# LINE 1 "Quipper/Libraries/GateDecompositions.hs" #-}
module Quipper.Libraries.GateDecompositions where
import Quipper
import Control.Monad
toffoli_NC_at :: Qubit -> Signed Qubit -> Signed Qubit -> Circ ()
toffoli_NC_at q c1 c2 = do
comment_with_label "ENTER: toffoli_NC" (q,c1,c2) ("q","c1","c2")
let x = get_sign c1
y = get_sign c2
w1 = from_signed c1
w2 = from_signed c2
hadamard_at q
qnot_at q `controlled` w1
reverse_imp_if (not x) gate_T_inv_at q
qnot_at q `controlled` w2
reverse_imp_if (x `xor` y) gate_T_at q
qnot_at q `controlled` w1
reverse_imp_if (not y) gate_T_inv_at q
qnot_at q `controlled` w2
gate_T_at q
reverse_imp_if (not x) gate_T_inv_at w1
hadamard_at q
qnot_at w1 `controlled` w2
reverse_imp_if (x `xor` y) gate_T_inv_at w1
qnot_at w1 `controlled` w2
reverse_imp_if (not x) gate_S_at w1
reverse_imp_if (not y) gate_T_at w2
comment_with_label "EXIT: toffoli_NC" (q,c1,c2) ("q","c1","c2")
where
xor = (/=)
toffoli_AMMR_at :: Qubit -> Signed Qubit -> Signed Qubit -> Circ ()
toffoli_AMMR_at q c1 c2 = do
comment_with_label "ENTER: toffoli_AMMR" (q,c1,c2) ("q","c1","c2")
without_comments $ do
hadamard_at q
ccZ_AMMR_at q c1 c2
hadamard_at q
comment_with_label "EXIT: toffoli_AMMR" (q,c1,c2) ("q","c1","c2")
toffoli_V_at :: Qubit -> Signed Qubit -> Signed Qubit -> Circ ()
toffoli_V_at q c1 c2 = do
comment_with_label "ENTER: toffoli_V" (q,c1,c2) ("q","c1","c2")
let q1 = from_signed c1
let q2 = from_signed c2
gate_V_at q `controlled` c1
qnot_at q1 `controlled` c2
gate_V_inv_at q `controlled` c1
qnot_at q1 `controlled` c2
gate_V_at q `controlled` c2
comment_with_label "EXIT: toffoli_V" (q,c1,c2) ("q","c1","c2")
toffoli_S_at :: Qubit -> Signed Qubit -> Signed Qubit -> Circ ()
toffoli_S_at q c1 c2 = do
comment_with_label "ENTER: toffoli_S" (q,c1,c2) ("q","c1","c2")
without_comments $ do
hadamard_at q
ccZ_S_at q c1 c2
hadamard_at q
comment_with_label "EXIT: toffoli_S" (q,c1,c2) ("q","c1","c2")
cc_iX_at :: Qubit -> Signed Qubit -> Signed Qubit -> Circ ()
cc_iX_at q c1 c2 = do
comment_with_label "ENTER: cc_iX" (q,c1,c2) ("q","c1","c2")
let x = get_sign c1
y = get_sign c2
w1 = from_signed c1
w2 = from_signed c2
hadamard_at q
qnot_at w1 `controlled` q
qnot_at w2 `controlled` w1
reverse_imp_if (not x) gate_T_at w1
reverse_imp_if (x `xor` y) gate_T_inv_at w2
qnot_at w1 `controlled` q
qnot_at w2 `controlled` w1
gate_T_inv_at q
reverse_imp_if (not y) gate_T_at w2
qnot_at w2 `controlled` q
hadamard_at q
when (not x && not y) $ do
gate_omega_at w1
gate_omega_at w2
comment_with_label "EXIT: cc_iX" (q,c1,c2) ("q","c1","c2")
where
xor = (/=)
cc_iX_simple_at :: Qubit -> Signed Qubit -> Signed Qubit -> Circ ()
cc_iX_simple_at q c1 c2 = do
comment_with_label "ENTER: cc_iX_simple" (q,c1,c2) ("q","c1","c2")
hadamard_at q
qnot_at q `controlled` c1
gate_T_at q
qnot_at q `controlled` c2
gate_T_inv_at q
qnot_at q `controlled` c1
gate_T_at q
qnot_at q `controlled` c2
gate_T_inv_at q
hadamard_at q
comment_with_label "EXIT: cc_iX_simple" (q,c1,c2) ("q","c1","c2")
cc_iX_S_at :: Qubit -> Signed Qubit -> Signed Qubit -> Circ ()
cc_iX_S_at q c1 c2 = do
comment_with_label "ENTER: cc_iX_S" (q,c1,c2) ("q","c1","c2")
let sx = get_sign c1
sy = get_sign c2
x = from_signed c1
y = from_signed c2
z = q
hadamard_at z
with_ancilla $ \w -> do
qnot y `controlled` z
qnot w `controlled` x
qnot x `controlled` z
qnot w `controlled` y
reverse_imp_if (not sx) gate_T_at x
reverse_imp_if (not sy) gate_T_at y
gate_T_inv_at z
reverse_imp_if (sx `xor` sy) gate_T_inv_at w
qnot w `controlled` y
qnot x `controlled` z
qnot w `controlled` x
qnot y `controlled` z
when (not sx && not sy) $ do
gate_omega_at x
gate_omega_at y
hadamard_at z
comment_with_label "EXIT: cc_iX_S" (q,c1,c2) ("q","c1","c2")
where
xor = (/=)
ccZ_AMMR_at :: Qubit -> Signed Qubit -> Signed Qubit -> Circ ()
ccZ_AMMR_at q c1 c2 = do
comment_with_label "ENTER: ccZ_AMMR" (q,c1,c2) ("q","c1","c2")
let x = get_sign c1
y = get_sign c2
w1 = from_signed c1
w2 = from_signed c2
gate_T_at q
reverse_imp_if (not x) gate_T_at w1
reverse_imp_if (not y) gate_T_at w2
qnot_at w2 `controlled` w1
qnot_at w1 `controlled` q
qnot_at q `controlled` w2
reverse_imp_if (not x) gate_T_inv_at w1
reverse_imp_if (x `xor` y) gate_T_at q
qnot_at w1 `controlled` w2
reverse_imp_if (not y) gate_T_inv_at w1
reverse_imp_if (x `xor` y) gate_T_inv_at w2
qnot_at w1 `controlled` q
qnot_at q `controlled` w2
qnot_at w2 `controlled` w1
comment_with_label "EXIT: ccZ_AMMR" (q,c1,c2) ("q","c1","c2")
where
xor = (/=)
ccZ_S_at :: Qubit -> Signed Qubit -> Signed Qubit -> Circ ()
ccZ_S_at q c1 c2 = do
comment_with_label "ENTER: ccZ_S" (q,c1,c2) ("q","c1","c2")
let sx = get_sign c1
sy = get_sign c2
x = from_signed c1
y = from_signed c2
z = q
with_ancilla_init (0,0,0,0) $ \(xyz, xy, yz, xz) -> do
qnot yz `controlled` y
qnot xyz `controlled` x
qnot xy `controlled` y
qnot yz `controlled` z
qnot xz `controlled` xyz
qnot xy `controlled` x
qnot xz `controlled` z
qnot xyz `controlled` yz
reverse_imp_if (not sx) gate_T_at x
reverse_imp_if (not sy) gate_T_at y
gate_T_at z
reverse_imp_if (sx `xor` sy) gate_T_at xyz
reverse_imp_if (sx `xor` sy) gate_T_inv_at xy
reverse_imp_if (not sy) gate_T_inv_at yz
reverse_imp_if (not sx) gate_T_inv_at xz
qnot xyz `controlled` yz
qnot xz `controlled` z
qnot xy `controlled` x
qnot xz `controlled` xyz
qnot yz `controlled` z
qnot xy `controlled` y
qnot xyz `controlled` x
qnot yz `controlled` y
comment_with_label "EXIT: ccZ_S" (q,c1,c2) ("q","c1","c2")
where
xor = (/=)
fredkin_at :: Qubit -> Qubit -> Signed Qubit -> Circ ()
fredkin_at q1 q2 c = do
comment_with_label "ENTER: fredkin" (q1,q2,c) ("q1","q2","c")
without_controls $ do
qnot_at q2 `controlled` q1
toffoli_AMMR_at q1 (Signed q2 True) c
qnot_at q2 `controlled` q1
comment_with_label "EXIT: fredkin" (q1,q2,c) ("q1","q2","c")
cH_AMMR_at :: Qubit -> Signed Qubit -> Circ ()
cH_AMMR_at q c = do
comment_with_label "ENTER: cH_AMMR" (q,c) ("q","c")
gate_S_inv_at q
hadamard_at q
gate_T_inv_at q
qnot_at q `controlled` c
gate_T_at q
hadamard_at q
gate_S_at q
comment_with_label "EXIT: cH_AMMR" (q,c) ("q","c")
controlled_W_at :: Qubit -> Qubit -> Signed Qubit -> Circ ()
controlled_W_at q1 q2 c = do
comment_with_label "ENTER: controlled_W" (q1,q2,c) ("W1","W2","c")
without_comments $ do
qnot_at q2 `controlled` q1
gate_S_inv_at q1
hadamard_at q1
gate_T_inv_at q1
toffoli_AMMR_at q1 (Signed q2 True) c
gate_T_at q1
hadamard_at q1
gate_S_at q1
qnot_at q2 `controlled` q1
comment_with_label "EXIT: controlled_W" (q1,q2,c) ("W1","W2","c")
gate_W_CliffordT_at :: Qubit -> Qubit -> Circ ()
gate_W_CliffordT_at q1 q2 = do
comment_with_label "ENTER: gate_W_CliffordT" (q1,q2) ("W1","W2")
without_comments $ do
qnot_at q2 `controlled` q1
cH_AMMR_at q1 (Signed q2 True)
qnot_at q2 `controlled` q1
comment_with_label "EXIT: gate_W_CliffordT" (q1,q2) ("W1","W2")
controlled_iX_at :: Qubit -> Signed Qubit -> Circ ()
controlled_iX_at q c = do
comment_with_label "ENTER: controlled_iX" (q,c) ("q","c")
let x = get_sign c
w = from_signed c
qnot_at q `controlled` c
reverse_imp_if (not x) gate_S_at w
when (not x) $ do
gate_omega_at q
gate_omega_at w
comment_with_label "EXIT: controlled_iX" (q,c) ("q","c")
controlled_S_at :: Qubit -> Signed Qubit -> Circ ()
controlled_S_at q c = do
comment_with_label "ENTER: controlled_S" (q,c) ("q","c")
let x = get_sign c
w = from_signed c
qnot w `controlled` q
reverse_imp_if (not x) gate_T_inv_at w
qnot w `controlled` q
reverse_imp_if (not x) gate_T_at w
gate_T_at q
comment_with_label "EXIT: controlled_S" (q,c) ("q","c")
controlled_T_at :: Qubit -> Signed Qubit -> Circ ()
controlled_T_at q c = do
comment_with_label "ENTER: controlled_T" (q,c) ("q","c")
without_comments $ do
with_ancilla_init False $ \r -> do
cc_iX_at r (Signed q True) c
gate_T_at r
reverse_generic_imp cc_iX_at r (Signed q True) c
comment_with_label "EXIT: controlled_T" (q,c) ("q","c")
controlled_V_at :: Qubit -> Signed Qubit -> Circ ()
controlled_V_at q c = do
comment_with_label "ENTER: controlled_V" (q,c) ("q","c")
let x = get_sign c
w = from_signed c
hadamard_at q
reverse_imp_if (not x) gate_T_inv_at w
qnot w `controlled` q
reverse_imp_if (not x) gate_T_at w
gate_T_inv_at q
qnot w `controlled` q
hadamard_at q
comment_with_label "EXIT: controlled_V" (q,c) ("q","c")
controlled_E_at :: Qubit -> Signed Qubit -> Circ ()
controlled_E_at q c = do
comment_with_label "ENTER: controlled_E" (q,c) ("q","c")
with_signed_qubit c $ \r -> do
gate_H_at q
gate_S_at r
gate_T_at q
qnot_at q `controlled` r
gate_T_inv_at q
gate_H_at q
qnot_at r `controlled` q
gate_T_at r
gate_T_inv_at q
qnot_at r `controlled` q
comment_with_label "EXIT: controlled_E" (q,c) ("q","c")
controlled_YY_at :: Qubit -> Signed Qubit -> Circ ()
controlled_YY_at q c = do
comment_with_label "ENTER: controlled_YY" (q,c) ("q","c")
gate_S_at q
qnot_at q `controlled` c
gate_S_inv_at q
hadamard_at q
gate_T_inv_at q
qnot_at q `controlled` c
gate_T_at q
hadamard_at q
comment_with_label "EXIT: controlled_YY" (q,c) ("q","c")
toffoli_plain_at :: Qubit -> Signed Qubit -> Signed Qubit -> Circ ()
toffoli_plain_at q c1 c2 = do
qnot_at q `controlled` (c1,c2)
cc_iX_plain_at :: Qubit -> Signed Qubit -> Signed Qubit -> Circ ()
cc_iX_plain_at q c1 c2 = do
gate_iX_at q `controlled` (c1,c2)
multi_cnot_barenco_at :: (Qubit -> Signed Qubit -> Signed Qubit -> Circ ()) -> (Qubit -> Signed Qubit -> Signed Qubit -> Circ ()) -> Qubit -> [Qubit] -> [Signed Qubit] -> Circ ()
multi_cnot_barenco_at my_toffoli_at my_ciX_at q as cs =
case cs of
[] -> do
qnot_at q
[c] -> do
qnot_at q `controlled` c
[c1,c2] -> do
my_toffoli_at q c1 c2
c:cs -> do
case as of
[] -> error "multi_cnot_barenco_at: too few ancillas"
a:as -> do
my_toffoli_at q (Signed a True) c
aux cs (a:as)
my_toffoli_at q (Signed a True) c
reverse_generic_imp aux cs (a:as)
where
aux :: [Signed Qubit] -> [Qubit] -> Circ ()
aux [] as = return ()
aux [c] as = return ()
aux [c1,c2] (a:as) = do
my_ciX_at a c1 c2
aux (c:cs) (a1:a2:as) = do
my_ciX_at a1 (Signed a2 True) c
aux cs (a2:as)
my_ciX_at a1 (Signed a2 True) c
aux _ _ = error "multi_cnot_barenco_at: too few ancillas"
multi_ciX_noancilla_at :: (Qubit -> Signed Qubit -> Signed Qubit -> Circ ()) -> Qubit -> [Signed Qubit] -> Circ ()
multi_ciX_noancilla_at my_ciX_at q [] = gate_iX_at q
multi_ciX_noancilla_at my_ciX_at q [c] = gate_iX_at q `controlled` c
multi_ciX_noancilla_at my_ciX_at q [c1,c2] = gate_iX_at q `controlled` [c1,c2]
multi_ciX_noancilla_at my_ciX_at q cs = do
hadamard_at q
gate_T_inv_at q
multi_cnot_barenco_at my_ciX_at my_ciX_at q as1 cs2
gate_T_at q
multi_cnot_barenco_at my_ciX_at my_ciX_at q as2 cs1
gate_T_inv_at q
reverse_generic_imp (multi_cnot_barenco_at my_ciX_at my_ciX_at) q as1 cs2
gate_T_at q
reverse_generic_imp (multi_cnot_barenco_at my_ciX_at my_ciX_at) q as2 cs1
hadamard_at q
where
n = length cs
(cs1, cs2) = splitAt (n `div` 2) cs
as1 = map from_signed cs1
as2 = map from_signed cs2
partition_controls :: [Signed Endpoint] -> ([Signed Qubit], [Signed Bit])
partition_controls cs = (qcs, ccs) where
qcs = [ Signed q b | Signed (Endpoint_Qubit q) b <- cs ]
ccs = [ Signed c b | Signed (Endpoint_Bit c) b <- cs ]
with_signed_qubit :: Signed Qubit -> (Qubit -> Circ b) -> Circ b
with_signed_qubit (Signed q True) f = f q
with_signed_qubit (Signed q False) f = do
gate_X_at q
b <- f q
gate_X_at q
return b
with_combined_controls :: (Qubit -> Signed Qubit -> Signed Qubit -> Circ ()) -> Int -> [Signed Endpoint] -> ([Signed Qubit] -> Circ a) -> Circ a
with_combined_controls my_toffoli_at n cs code = circ where
(qcs, ccs) = partition_controls cs
len = length qcs
m = if len <= n then 0 else len - n
circ = with_controls ccs $ do
aux m qcs code
aux 0 qcs code = code qcs
aux n [] code = code []
aux n [c] code = code [c]
aux n (c1:c2:qcs) code = do
with_computed (quantum_and c1 c2) $ \c -> do
aux (n-1) (qcs ++ [Signed c True]) code
quantum_and :: Signed Qubit -> Signed Qubit -> Circ Qubit
quantum_and c1 c2 = do
q <- qinit 0
my_toffoli_at q c1 c2
return q