QIO-1.3: The Quantum IO Monad is a library for defining quantum computations in Haskell

Safe HaskellNone
LanguageHaskell2010

QIO.QioSynAlt

Contents

Description

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.

Synopsis

Documentation

type RR = Double Source #

For Real numbers, we simply use the built in Double type

type CC = Complex RR Source #

For Complex numbers, we use the built in Complex numbers, over our Real number type (i.e. Double)

amp :: CC -> RR Source #

The amplitude of a complex number is the magnitude squared.

newtype Qbit Source #

The type of Qubits in QIO are simply integer references.

Constructors

Qbit Int 

Instances

Enum Qbit Source # 

Methods

succ :: Qbit -> Qbit #

pred :: Qbit -> Qbit #

toEnum :: Int -> Qbit #

fromEnum :: Qbit -> Int #

enumFrom :: Qbit -> [Qbit] #

enumFromThen :: Qbit -> Qbit -> [Qbit] #

enumFromTo :: Qbit -> Qbit -> [Qbit] #

enumFromThenTo :: Qbit -> Qbit -> Qbit -> [Qbit] #

Eq Qbit Source # 

Methods

(==) :: Qbit -> Qbit -> Bool #

(/=) :: Qbit -> Qbit -> Bool #

Num Qbit Source # 

Methods

(+) :: Qbit -> Qbit -> Qbit #

(-) :: Qbit -> Qbit -> Qbit #

(*) :: Qbit -> Qbit -> Qbit #

negate :: Qbit -> Qbit #

abs :: Qbit -> Qbit #

signum :: Qbit -> Qbit #

fromInteger :: Integer -> Qbit #

Ord Qbit Source # 

Methods

compare :: Qbit -> Qbit -> Ordering #

(<) :: Qbit -> Qbit -> Bool #

(<=) :: Qbit -> Qbit -> Bool #

(>) :: Qbit -> Qbit -> Bool #

(>=) :: Qbit -> Qbit -> Bool #

max :: Qbit -> Qbit -> Qbit #

min :: Qbit -> Qbit -> Qbit #

Show Qbit Source #

We can display a qubit reference

Methods

showsPrec :: Int -> Qbit -> ShowS #

show :: Qbit -> String #

showList :: [Qbit] -> ShowS #

type Rotation = (Bool, Bool) -> CC Source #

A rotation is in essence a two-by-two complex valued matrix

rid :: Rotation Source #

The identity rotation

rnot :: Rotation Source #

The not rotation

rhad :: Rotation Source #

The hadamard rotation

rphase :: RR -> Rotation Source #

The phase rotation

rrev :: Rotation -> Rotation Source #

Returns the inverse (or reverse) of the given rotation

data UFunctor u Source #

The non-recursive data type definition of a unitary operation

Constructors

UReturn 
Rot Qbit Rotation u 
Swap Qbit Qbit u 
Cond Qbit (Bool -> u) u 
Ulet Bool (Qbit -> u) u 

Instances

Functor UFunctor Source #

In order to define an F-Algebra, UFunctor must be a functor.

Methods

fmap :: (a -> b) -> UFunctor a -> UFunctor b #

(<$) :: a -> UFunctor b -> UFunctor a #

Show U Source #

We can display a representation of a unitary, using an F-Algebra

Methods

showsPrec :: Int -> U -> ShowS #

show :: U -> String #

showList :: [U] -> ShowS #

Monoid U Source #

The type U forms a Monoid.

Methods

mempty :: U #

mappend :: U -> U -> U #

mconcat :: [U] -> U #

newtype Fix f Source #

The fix point type construtor.

Constructors

Fx (f (Fix f)) 

Instances

Show U Source #

We can display a representation of a unitary, using an F-Algebra

Methods

showsPrec :: Int -> U -> ShowS #

show :: U -> String #

showList :: [U] -> ShowS #

Monoid U Source #

The type U forms a Monoid.

Methods

mempty :: U #

mappend :: U -> U -> U #

mconcat :: [U] -> U #

unFix :: Fix f -> f (Fix f) Source #

We can define the inverse of Fx

type U = Fix UFunctor Source #

We fix the non-recursice data-type in order to get our type U of unitary operations.

type Algebra f a = f a -> a Source #

The type of an F-Algebra.

type UInitialAlgebra = Algebra UFunctor U Source #

The type of the initial algebra for UFunctor

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

rot :: Qbit -> Rotation -> U Source #

Apply the given rotation to the given qubit

swap :: Qbit -> Qbit -> U Source #

Swap the state of the two given qubits

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

unot :: Qbit -> U Source #

Apply a not rotation to the given qubit

uhad :: Qbit -> U Source #

Apply a hadamard rotation to the given qubit

uphase :: Qbit -> RR -> U Source #

Apply a phase rotation (of the given angle) to the given qubit

urev :: U -> U Source #

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

Constructors

QReturn a 
MkQbit Bool (Qbit -> q) 
ApplyU U q 
Meas Qbit (Bool -> q) 

Instances

Functor (QIOFunctor a) Source #

In order to define an F-Algebra, UF must be a functor.

Methods

fmap :: (a -> b) -> QIOFunctor a a -> QIOFunctor a b #

(<$) :: a -> QIOFunctor a b -> QIOFunctor a a #

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

data QIO a Source #

The QIO type forms a Monad, by wrapping QIOprim

Constructors

Apply (Fix (QIOFunctor a)) 

Instances

Monad QIO Source #

The wrapper type ApplyFix forms a Monad

Methods

(>>=) :: QIO a -> (a -> QIO b) -> QIO b #

(>>) :: QIO a -> QIO b -> QIO b #

return :: a -> QIO a #

fail :: String -> QIO a #

Functor QIO Source # 

Methods

fmap :: (a -> b) -> QIO a -> QIO b #

(<$) :: a -> QIO b -> QIO a #

Applicative QIO Source # 

Methods

pure :: a -> QIO a #

(<*>) :: QIO (a -> b) -> QIO a -> QIO b #

(*>) :: QIO a -> QIO b -> QIO b #

(<*) :: QIO a -> QIO b -> QIO a #

Show a => Show (QIO a) Source #

We can show a QIO computation, using an F-Algebra

Methods

showsPrec :: Int -> QIO a -> ShowS #

show :: QIO a -> String #

showList :: [QIO a] -> ShowS #

primQIO :: QIO a -> QIOprim a Source #

We can remove the wrapper.

mkQbit :: Bool -> QIO Qbit Source #

Initialise a qubit in the given state (adding it to the overall quantum state)

applyU :: U -> QIO () Source #

Apply the given unitary operation to the current 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

toffoli :: Qbit -> Qbit -> Qbit -> U Source #

Orphan instances

Eq Rotation Source #

Rotations can be compared for equality. They are equal if the define the same matrix.

Show Rotation Source #

We can display the matrix representation of a rotation