```{-# OPTIONS_GHC -fglasgow-exts -fallow-undecidable-instances #-}

module QIO.Qdata where

import Data.Monoid as Monoid
import QIO.QioSyn

class Qdata a qa | a -> qa, qa -> a where
mkQ :: a -> QIO qa
measQ :: qa -> QIO a
letU :: a -> (qa -> U) -> U
condQ :: qa -> (a -> U) -> U

instance Qdata Bool Qbit where
mkQ = mkQbit
measQ = measQbit
letU b xu = ulet b xu
condQ q br = cond q br

instance (Qdata a qa,Qdata b qb) => Qdata (a,b) (qa,qb) where

mkQ (a,b) = do qa <- mkQ a
qb <- mkQ b
return (qa,qb)

measQ (qa,qb) = do a <- measQ qa
b <- measQ qb
return (a,b)

letU (a,b) xyu = letU a (\ x -> letU b (\ y -> xyu (x,y)))

condQ (qa,qb) br = condQ qa (\x -> condQ qb (\y -> br (x,y)))

instance Qdata a qa => Qdata [a] [qa] where
mkQ n = sequence (map mkQ n)
measQ qs = sequence (map measQ qs)
letU as xsu = letU' as []
where letU' [] xs = xsu xs
letU' (a:as) xs = letU a (\ x -> letU' as (xs++[x]))
condQ qs qsu = condQ' qs []
where condQ' [] xs = qsu xs
condQ' (a:as) xs = condQ a (\ x -> condQ' as (xs++[x]))

condQRec :: Qdata a qa => [qa] -> [(a -> U)] -> U
condQRec [] [] = mempty
condQRec (q:qs) (u:us) = (condQ q u) `mappend` condQRec qs us

qIntSize :: Int
qIntSize = 4

newtype QInt = QInt [Qbit] deriving Show

int2bits :: Int -> [Bool]
int2bits n = int2bits' n qIntSize
where int2bits' 0 0 = []
int2bits' _ 0 = error "int2bits: too large"
int2bits' n l = ((n `mod` 2) /= 0) : int2bits' (n `div` 2) (l-1)

bits2int :: [Bool] -> Int
bits2int [] = 0
bits2int (b:bs) = (2*bits2int bs)+(if b then 1 else 0)

instance Qdata Int QInt where
mkQ n = do qn <- mkQ (int2bits n)
return (QInt qn)
measQ (QInt qbs) =
do bs <- measQ qbs
return (bits2int bs)
letU n xu = letU (int2bits n) (\ bs -> xu (QInt bs))
condQ (QInt qi) qiu = condQ qi (\ x -> qiu (bits2int x))
```