module Quipper102 where
import System.Random
import Quipper
import Quipper.Libraries.Simulation


ex_or :: Qubit -> Qubit -> Circ (Qubit, Qubit, Qubit)
ex_or x y = do
  z <- qinit False
  z <- qnot z `controlled` x
  z <- qnot z `controlled` y
  return (x, y, z)

exOrCirc =
  print_generic Preview ex_or qubit qubit 

g :: Qubit -> Qubit -> Qubit -> Circ (Qubit, Qubit, Qubit, Qubit, Qubit, Qubit, Qubit)
g x y z = do
  (x, y, q1) <- ex_or x y
  (x, z, q2) <- ex_or x z
  (y, z, q3) <- ex_or y z
  (x, q3, q4)<- ex_or x q3
  return (x, y, z, q1, q2, q3, q4)

gCirc =
  print_generic Preview g qubit qubit qubit
  
-- ccz using Clifford+T
ccz :: Qubit -> Qubit -> Qubit -> Circ (Qubit, Qubit, Qubit)
ccz x y z = do
  with_computed (g x y z) b 
  where b (x, y, z, q1, q2, q3, q4) = do
          x <- gate_T x
          y <- gate_T y
          z <- gate_T z
          q1 <- gate_T_inv q1
          q2 <- gate_T_inv q2
          q3 <- gate_T_inv q3
          q4 <- gate_T q4
          return (x, y, z)

cczCirc =
  print_generic Preview ccz qubit qubit qubit
          
-- from ccz to ccx
toffoli :: Qubit -> Qubit -> Qubit -> Circ (Qubit, Qubit, Qubit)
toffoli x y z = do
  z <- hadamard z
  (x, y, z) <- ccz x y z
  z <- hadamard z
  return (x,y,z)

toffoliCirc =
  print_generic Preview toffoli qubit qubit qubit

testToffoli :: IO ()
testToffoli = do 
  let x = sim_generic (0.0 :: Double) toffoli
           True True True
  putStrLn $ show x

  

bit_addCirc =
  print_generic Preview bit_add qubit qubit qubit qubit


majority :: Qubit -> Qubit -> Qubit -> Qubit
            -> Circ Qubit
majority x y carryin carryout = do
  carryout <- qnot carryout `controlled` (x, y)
  carryout <- qnot carryout `controlled` (y, carryin)
  carryout <- qnot carryout `controlled` (x, carryin)
  return carryout


majorityCirc = print_generic Preview majority qubit qubit qubit qubit


twoBitAdd :: Qubit -> Qubit -> Qubit -> Qubit -> Qubit -> Qubit -> Qubit -> Circ (Qubit, Qubit, Qubit)
twoBitAdd x1 y1 x2 y2 s1 s2 carryout = do
  label (x1,y1, x2, y2, s1, s2, carryout) ("x1", "y1", "x2", "y2", "s1", "s2", "carryout")
  carryin <- qinit False
  carryout1 <- qinit False
  label (carryin, carryout1) ("carryin", "carryout1")
  (s1, carryout1) <- singleBitAdd x1 y1 carryin s1 carryout1
  (s2, carryout) <- singleBitAdd x2 y2 carryout1 s2 carryout
  return (s1,s2, carryout)



twoBitCirc = print_generic Preview twoBitAdd qubit qubit qubit qubit qubit qubit qubit 



majority' :: Qubit -> Qubit -> Qubit -> Circ Qubit
majority' x y c = do
  carryout <- qinit False
  carryout <- qnot carryout `controlled` (x, y)
  carryout <- qnot carryout `controlled` (y, c)
  carryout <- qnot carryout `controlled` (x, c)
  return carryout

unmajority' :: Qubit -> Qubit -> Qubit -> Qubit -> Circ ()
unmajority' x y c carryout = do
  carryout <- qnot carryout `controlled` (x, c)
  carryout <- qnot carryout `controlled` (y, c)
  carryout <- qnot carryout `controlled` (x, y)
  qterm False carryout

unmajorityCirc = print_generic Preview unmajority' qubit qubit qubit qubit

-- Adder via toffoli
bit_add :: Qubit -> Qubit -> Qubit -> Qubit ->
           Circ (Qubit, Qubit, Qubit, Qubit)
bit_add x y c z = do
  (z, x) <- controlled_not z x
  (z, y) <- controlled_not z y
  (z, c) <- controlled_not z c
  return (x, y, c, z)
  
adderBracket :: [Qubit] -> [Qubit] -> [Qubit] -> Qubit -> Qubit -> Circ([Qubit], Qubit, Qubit)
adderBracket [] [] [] carryin carryout = return ([], carryin, carryout)
-- adding the most significant bit
adderBracket (x:[]) (y:[]) (s:[]) carryin carryout = do
  c <- majority' x y carryin
  (x, y, carryin, s) <- bit_add x y carryin s
  (carryout, c) <- controlled_not carryout c
  unmajority' x y carryin c
  return ([s], carryin, carryout)

adderBracket (x:xs) (y:ys) (s:ss) carryin carryout = do
  c <- majority' x y carryin
  (x, y, carryin, s) <- bit_add x y carryin s
  (ss, c, carryout) <- adderBracket xs ys ss c carryout
  unmajority' x y carryin c
  return (s:ss, carryin, carryout)
  
adderBracketCirc = print_generic Preview adderBracket [qubit, qubit, qubit] [qubit, qubit, qubit] [qubit, qubit, qubit] qubit qubit

testAdderBracket :: IO ()
testAdderBracket = do 
  g <- newStdGen
  let x = sim_generic (0.0 :: Double) adderBracket [True, True, True] [True, True, True] [False, False, False] False False
  putStrLn $ show x

-- copy xs onto ys
bitcopy :: [Qubit] -> [Qubit] -> Circ([Qubit], [Qubit])
bitcopy xs ys = do
  zs <- sequence $ map (\ (y, x) -> controlled_not y x) $ zip ys xs
  let (ys, xs) = unzip zs
  return (xs, ys)

-- zip ys xs :: [(Qubit, Qubit)]
-- map (\ (y, x) -> controlled_not y x) $ zip ys xs :: [Circ (Qubit, Qubit)]
-- sequence $ map (\ (y, x) -> controlled_not y x) $ zip ys xs :: Circ [(Qubit, Qubit)]

copyCirc = print_generic Preview bitcopy [qubit, qubit, qubit] [qubit, qubit, qubit]

singleBitAdd :: Qubit -> Qubit -> Qubit -> Qubit -> Qubit ->  Circ (Qubit, Qubit)
singleBitAdd x y carryin s carryout = do
  (x, y, carryin, s) <- bit_add x y carryin s
  carryout <- majority x y carryin carryout
  return (s, carryout)

-- A version of singleBitAdd that uses two ancilla
singleBitAdd' :: Qubit -> Qubit -> Qubit  -> Circ (Qubit, Qubit)
singleBitAdd' x y carryin = do
  s <- qinit False
  carryout <- qinit False
  (x, y, carryin, s) <- bit_add x y carryin s
  carryout <- majority x y carryin carryout
  return (s, carryout)
  
singleBitCirc = print_generic Preview singleBitAdd' qubit qubit qubit 

-- A version of adder using with-computed
adder :: [Qubit] -> [Qubit] -> [Qubit]  -> Qubit -> Circ([Qubit], Qubit)
adder xs ys output carryout =
  with_computed (do{c <- qinit False;
                    addition xs ys c}) (copying output carryout)
  where addition [] [] c = return ([], c)
        addition (x:xs) (y:ys) c = do
          (s, c') <- singleBitAdd' x y c
          (ss, c'') <- addition xs ys c'
          return (s:ss, c'')
        copying ::  [Qubit] -> Qubit-> ([Qubit], Qubit) -> Circ ([Qubit], Qubit)
        copying output carryout (ss, c) = do
          (_, carryout:output) <- bitcopy (c:ss) (carryout:output)
          return (output, carryout)
          
  
adderCirc = print_generic Preview adder [qubit, qubit, qubit] [qubit, qubit, qubit] [qubit, qubit, qubit] qubit
          
testAdder :: IO ()
testAdder = do 
  g <- newStdGen
  let x = sim_generic (0.0 :: Double) adder [True, False, False] [True, True, True] [False, False, False] False
  putStrLn $ show x