module QIO.Qft where

import Data.Monoid as Monoid
import QIO.QioSyn
import QIO.Qio
import QIO.Qdata

qft :: [Qbit] -> U
qft qs = condQ qs (\bs -> qftAcu qs bs [])


qftAcu :: [Qbit] -> [Bool] -> [Bool] -> U
qftAcu [] [] _ = mempty
qftAcu (q:qs) (b:bs) cs = qftBase cs q `mappend` qftAcu qs bs (b:cs)

qftBase :: [Bool] -> Qbit -> U
qftBase bs q =  f' bs q 2
	where f' [] q _ = uhad q
	      f' (b:bs) q x = if b then (rotK x q) `mappend` f' bs q (x+1) 
			      else f' bs q (x+1)

--need to change this into a conQRec???



-- e.g. qft [Qbit 0]
-- = condQ [Qbit 0] (\(b:bs) -> uhad 0 `mappend` mempty)
-- but gives  cond 0 (\x -> if x then uhad 0 else uhad 0) which is forbidden

testCond :: [Qbit] -> U
testCond [] = mempty
testCond (q:qs) = condQ (q:qs) (\bs -> uhad q)

testCondOk :: [Qbit] -> U
testCondOk [] = mempty
testCondOk (q:qs) = condQ (qs) (\bs -> uhad q)

rotK :: Int -> Qbit -> U
rotK k q = uphase q (1.0/(2.0^k))

tryQft :: Int -> QIO Int
tryQft n = do QInt qs <- mkQ n
	      applyU(qft qs)
	      x <- measQ (QInt qs)
	      return x

tC :: (Qbit,Qbit) -> U
tC qxy = condQ qxy (\xy -> tC' qxy xy)

tC' :: (Qbit,Qbit) -> (Bool,Bool) -> U
tC' (qx,qy) (x,y) = if x then unot qy else mempty

testTC :: QIO (Bool,Bool)
testTC = do (qx,qy) <- mkQ (False,False)
	    applyU (uhad qx)
            applyU (tC (qx,qy))
            measQ (qx,qy)