Safe Haskell | None |
---|---|
Language | Haskell2010 |
This module defines the Syntax of the Quantum IO Monad, which is an embedded language for writing quantum computations. It is an alternative definition using the approach of defining F-Algebras.
- type RR = Double
- type CC = Complex RR
- amp :: CC -> RR
- newtype Qbit = Qbit Int
- type Rotation = (Bool, Bool) -> CC
- rid :: Rotation
- rnot :: Rotation
- rhad :: Rotation
- rphase :: RR -> Rotation
- rrev :: Rotation -> Rotation
- data UFunctor u
- newtype Fix f = Fx (f (Fix f))
- unFix :: Fix f -> f (Fix f)
- type U = Fix UFunctor
- type Algebra f a = f a -> a
- type UInitialAlgebra = Algebra UFunctor U
- uInitialAlgebra :: UInitialAlgebra
- cata :: Functor f => Algebra f a -> Fix f -> a
- rot :: Qbit -> Rotation -> U
- swap :: Qbit -> Qbit -> U
- cond :: Qbit -> (Bool -> U) -> U
- ulet :: Bool -> (Qbit -> U) -> U
- unot :: Qbit -> U
- uhad :: Qbit -> U
- uphase :: Qbit -> RR -> U
- urev :: U -> U
- data QIOFunctor a q
- type QIOprim a = Fix (QIOFunctor a)
- type QIOInitialAlgebra a = Algebra (QIOFunctor a) (QIOprim a)
- qioInitialAlgebra :: QIOInitialAlgebra a
- data QIO a = Apply (Fix (QIOFunctor a))
- primQIO :: QIO a -> QIOprim a
- mkQbit :: Bool -> QIO Qbit
- applyU :: U -> QIO ()
- measQbit :: Qbit -> QIO Bool
- count :: QIO a -> (Int, Int, Int)
- toffoli :: Qbit -> Qbit -> Qbit -> U
- and :: Bool -> Bool -> QIO Bool
Documentation
For Complex numbers, we use the built in Complex numbers, over our Real number type (i.e. Double)
The type of Qubits in QIO are simply integer references.
type Rotation = (Bool, Bool) -> CC Source #
A rotation is in essence a two-by-two complex valued matrix
The non-recursive data type definition of a unitary operation
The fix point type construtor.
type U = Fix UFunctor Source #
We fix the non-recursice data-type in order to get our type U
of unitary operations.
uInitialAlgebra :: UInitialAlgebra Source #
We can now define the initial algebra for U
cata :: Functor f => Algebra f a -> Fix f -> a Source #
We can use a catamorphism to abstract evaluation over a given algebra
cond :: Qbit -> (Bool -> U) -> U Source #
Apply the conditional unitary, depending on the value of the given qubit
ulet :: Bool -> (Qbit -> U) -> U Source #
Introduce an Ancilla qubit in the given state, for use in the sub-unitary
Returns the inverse (or reverse) of the given unitary operation, using an F-Algebra
data QIOFunctor a q Source #
The non-recursive data type definition of a QIO computation
Functor (QIOFunctor a) Source # | In order to define an F-Algebra, |
type QIOprim a = Fix (QIOFunctor a) Source #
We fix the non-recursice data-type in order to get our type U
of unitary operations.
type QIOInitialAlgebra a = Algebra (QIOFunctor a) (QIOprim a) Source #
The type of the initial algebra for UFunctor
qioInitialAlgebra :: QIOInitialAlgebra a Source #
We can now define the initial algebra for U
Apply (Fix (QIOFunctor a)) |
mkQbit :: Bool -> QIO Qbit Source #
Initialise a qubit in the given state (adding it to the overall quantum state)
measQbit :: Qbit -> QIO Bool Source #
Measure the given qubit, and return the measurement outcome (note that this operation may affect the overall quantum state, as a measurement is destructive)
count :: QIO a -> (Int, Int, Int) Source #
We can count the number of each primitive operation using an F-Algebra