Safe Haskell | None |
---|
Low-level quantum circuit implementation. This is our backend implementation of quantum circuits. Note: there is no run-time error checking at the moment.
At its heart, a circuit is a list of gates. All well-definedness checking (e.g. input arity, output arity, and checking that the intermediate gates are connected to legitimate wires) is done dynamically, at circuit generation time, and is not stored within the circuit itself. This allows circuits to be produced and consumed lazily.
Implementation note: this file is in the intermediate stage of a code refactoring, and should be considered "under renovation".
Synopsis
- type Wire = Int
- data Wiretype
- type Arity = IntMap Wiretype
- data Signed a = Signed a Bool
- from_signed :: Signed a -> a
- get_sign :: Signed a -> Bool
- type Controls = [Signed Wire]
- type Timestep = Double
- type InverseFlag = Bool
- type NoControlFlag = Bool
- data ControllableFlag
- data BoxId = BoxId String String
- data RepeatFlag = RepeatFlag Integer
- data Gate
- = QGate String InverseFlag [Wire] [Wire] Controls NoControlFlag
- | QRot String InverseFlag Timestep [Wire] [Wire] Controls NoControlFlag
- | GPhase Timestep [Wire] Controls NoControlFlag
- | CNot Wire Controls NoControlFlag
- | CGate String Wire [Wire] NoControlFlag
- | CGateInv String Wire [Wire] NoControlFlag
- | CSwap Wire Wire Controls NoControlFlag
- | QPrep Wire NoControlFlag
- | QUnprep Wire NoControlFlag
- | QInit Bool Wire NoControlFlag
- | CInit Bool Wire NoControlFlag
- | QTerm Bool Wire NoControlFlag
- | CTerm Bool Wire NoControlFlag
- | QMeas Wire
- | QDiscard Wire
- | CDiscard Wire
- | DTerm Bool Wire
- | Subroutine BoxId InverseFlag [Wire] Arity [Wire] Arity Controls NoControlFlag ControllableFlag RepeatFlag
- | Comment String InverseFlag [(Wire, String)]
- gate_arity :: Gate -> ([(Wire, Wiretype)], [(Wire, Wiretype)])
- gate_controls :: Gate -> Controls
- gate_ncflag :: Gate -> NoControlFlag
- gate_with_ncflag :: NoControlFlag -> Gate -> Gate
- gate_reverse :: Gate -> Gate
- wires_of_controls :: Controls -> IntSet
- wires_of_gate :: Gate -> IntSet
- wirelist_of_gate :: Gate -> [Wire]
- type ExtArity = XIntMap Wiretype
- arity_append_safe :: Gate -> ExtArity -> ExtArity
- arity_append_unsafe :: Gate -> ExtArity -> ExtArity
- arity_append :: Gate -> ExtArity -> ExtArity
- arity_empty :: ExtArity
- arity_unused_wire :: ExtArity -> Wire
- arity_unused_wires :: Int -> ExtArity -> [Wire]
- arity_alloc :: Wiretype -> ExtArity -> (Wire, ExtArity)
- arity_of_extarity :: ExtArity -> Arity
- n_of_extarity :: ExtArity -> Int
- type Circuit = (Arity, [Gate], Arity, Int)
- wirelist_of_circuit :: Circuit -> [Wire]
- reverse_gatelist :: [Gate] -> [Gate]
- reverse_circuit :: Circuit -> Circuit
- circuit_to_nocontrol :: Circuit -> Circuit
- newtype OCircuit = OCircuit ([Wire], Circuit, [Wire])
- reverse_ocircuit :: OCircuit -> OCircuit
- data CircuitTypeStructure a = CircuitTypeStructure (a -> ([Wire], Arity)) (([Wire], Arity) -> a)
- id_CircuitTypeStructure :: CircuitTypeStructure ([Wire], Arity)
- destructure_with :: CircuitTypeStructure a -> a -> ([Wire], Arity)
- structure_with :: CircuitTypeStructure a -> ([Wire], Arity) -> a
- data TypedSubroutine = (Typeable a, Typeable b) => TypedSubroutine OCircuit (CircuitTypeStructure a) (CircuitTypeStructure b) ControllableFlag
- circuit_of_typedsubroutine :: TypedSubroutine -> Circuit
- type Namespace = Map BoxId TypedSubroutine
- namespace_empty :: Namespace
- showNames :: Namespace -> String
- type BCircuit = (Circuit, Namespace)
- type OBCircuit = (OCircuit, Namespace)
- ob_circuit :: [Wire] -> BCircuit -> [Wire] -> OBCircuit
- reverse_bcircuit :: BCircuit -> BCircuit
- data ReadWrite a
- readwrite_wrap :: ReadWrite a -> ReadWrite ([Gate], a)
- readwrite_unwind_static :: ErrMsg -> ReadWrite a -> a
- gatelist_of_readwrite :: ErrMsg -> ReadWrite a -> Namespace -> ([Gate], Namespace, a)
- type DBCircuit a = (Arity, ReadWrite (Arity, Int, a))
- bcircuit_of_static_dbcircuit :: ErrMsg -> DBCircuit a -> (BCircuit, a)
- dbcircuit_of_bcircuit :: BCircuit -> a -> DBCircuit a
Quantum circuit data type
Wire identifier. Wires are currently identified by an integer, but the users of this interface should be oblivious to this.
Wire type. A wire is either quantum or classical.
type Arity = IntMap Wiretype Source #
An arity, also known as a typing context, is a map from a finite set of wires to wire types.
A signed item of type a. Signed
x True
represents a
positive item, and Signed
x False
represents a negative item.
When used with wires in a circuit, a positive sign is used to represent a positive control, i.e., a filled dot, and a negative sign is used to represent a negative control, i.e., an empty dot.
Instances
from_signed :: Signed a -> a Source #
Extract the underlying item of a signed item.
type Timestep = Double Source #
A time step is a small floating point number used as a parameter to certain gates, such as rotation gates or the e−iZt gate.
type InverseFlag = Bool Source #
A flag that, if True
, indicates that the gate is inverted.
type NoControlFlag = Bool Source #
A flag that, if True
, indicates that the gate is controllable,
but any further controls on the gate should be ignored. This is
used, e.g., for circuits consisting of a basis change, some
operation, and the inverse basis change. When controlling such a
circuit, it is sufficient to control the middle operation, so the
gates belonging to the basis change and its inverse will have the
NoControlFlag set.
data ControllableFlag Source #
A flag, to specify if the corresponding subroutine can be controlled. Either no control allowed, or all controls, or only classical.
Instances
Eq ControllableFlag # | |
Defined in Quipper.Internal.Circuit (==) :: ControllableFlag -> ControllableFlag -> Bool # (/=) :: ControllableFlag -> ControllableFlag -> Bool # | |
Ord ControllableFlag # | |
Defined in Quipper.Internal.Circuit compare :: ControllableFlag -> ControllableFlag -> Ordering # (<) :: ControllableFlag -> ControllableFlag -> Bool # (<=) :: ControllableFlag -> ControllableFlag -> Bool # (>) :: ControllableFlag -> ControllableFlag -> Bool # (>=) :: ControllableFlag -> ControllableFlag -> Bool # max :: ControllableFlag -> ControllableFlag -> ControllableFlag # min :: ControllableFlag -> ControllableFlag -> ControllableFlag # | |
Show ControllableFlag # | |
Defined in Quipper.Internal.Circuit showsPrec :: Int -> ControllableFlag -> ShowS # show :: ControllableFlag -> String # showList :: [ControllableFlag] -> ShowS # |
An identifier for a subroutine. A boxed subroutine is currently identified by a pair of: the user-defined name of the subroutine; and a value uniquely identifying the type and shape of the argument.
For now, we represent the shape as a string, because this gives an
easy total Ord
instance, needed for Data.Map. However, in
principle, one could also use a pair of a type representation and a
shape term. The implementation of this may change later.
data RepeatFlag Source #
A flag that indicates how many times a particular subroutine should be repeated. If non-zero, it implies some constraints on the type of the subroutine.
Instances
Eq RepeatFlag # | |
Defined in Quipper.Internal.Circuit (==) :: RepeatFlag -> RepeatFlag -> Bool # (/=) :: RepeatFlag -> RepeatFlag -> Bool # | |
Ord RepeatFlag # | |
Defined in Quipper.Internal.Circuit compare :: RepeatFlag -> RepeatFlag -> Ordering # (<) :: RepeatFlag -> RepeatFlag -> Bool # (<=) :: RepeatFlag -> RepeatFlag -> Bool # (>) :: RepeatFlag -> RepeatFlag -> Bool # (>=) :: RepeatFlag -> RepeatFlag -> Bool # max :: RepeatFlag -> RepeatFlag -> RepeatFlag # min :: RepeatFlag -> RepeatFlag -> RepeatFlag # | |
Show RepeatFlag # | |
Defined in Quipper.Internal.Circuit showsPrec :: Int -> RepeatFlag -> ShowS # show :: RepeatFlag -> String # showList :: [RepeatFlag] -> ShowS # |
The low-level representation of gates.
QGate String InverseFlag [Wire] [Wire] Controls NoControlFlag | A named reversible quantum gate: |
QRot String InverseFlag Timestep [Wire] [Wire] Controls NoControlFlag | A named reversible quantum gate that also depends on a real
parameter. This is typically used for phase and rotation
gates. The gate name can contain '%' as a place holder for
the parameter, e.g., |
GPhase Timestep [Wire] Controls NoControlFlag | Global phase gate: |
CNot Wire Controls NoControlFlag | |
CGate String Wire [Wire] NoControlFlag | Generic classical gate |
CGateInv String Wire [Wire] NoControlFlag | Uncompute classical gate |
CSwap Wire Wire Controls NoControlFlag | |
QPrep Wire NoControlFlag | |
QUnprep Wire NoControlFlag | Measurement |
QInit Bool Wire NoControlFlag | |
CInit Bool Wire NoControlFlag | |
QTerm Bool Wire NoControlFlag | Termination of a |
CTerm Bool Wire NoControlFlag | Termination of a |
QMeas Wire | |
QDiscard Wire | |
CDiscard Wire | |
DTerm Bool Wire | Termination of a |
Subroutine BoxId InverseFlag [Wire] Arity [Wire] Arity Controls NoControlFlag ControllableFlag RepeatFlag | Reference to a subroutine, assumed to be bound to another circuit. Arbitrary input and output arities. The domain of a1 must include the range of ws1, and similarly for a2 and ws2. |
Comment String InverseFlag [(Wire, String)] | A comment. Does nothing, but can be useful for marking a location or some wires in a circuit. |
Basic information about gates
gate_arity :: Gate -> ([(Wire, Wiretype)], [(Wire, Wiretype)]) Source #
Compute the incoming and outgoing wires of a given gate
(excluding controls, comments, and anchors). This essentially
encodes the type information of the basic gates. If a wire is used
multiple times as an input or output, then gate_arity
also
returns it multiple times; this enables run-time type checking.
Note that gate_arity
returns the logical wires, and therefore
excludes things like labels, comments, and graphical anchors. This
is in contrast to wires_of_gate
, which returns the syntactic
set of wires used by the gate.
gate_controls :: Gate -> Controls Source #
Return the controls of a gate (or an empty list if the gate has no controls).
gate_ncflag :: Gate -> NoControlFlag Source #
Return the NoControlFlag
of a gate, or False
if it doesn't have one.
gate_with_ncflag :: NoControlFlag -> Gate -> Gate Source #
Apply the given NoControlFlag
to the given Gate
. This means,
if the first parameter is True
, set the gate's NoControlFlag
,
otherwise do nothing. Throw an error if attempting to set the
NoControlFlag
on a gate that can't support this flag.
gate_reverse :: Gate -> Gate Source #
Reverse a gate. Throw an error if the gate is not reversible.
Auxiliary functions on gates and wires
wires_of_controls :: Controls -> IntSet Source #
Return the set of wires used by a list of controls.
wires_of_gate :: Gate -> IntSet Source #
Return the set of wires used by a gate (including controls, labels, and anchors).
Unlike gate_arity
, the function wires_of_gate
is used for
printing, and therefore returns all wires that are syntactically
used by the gate, irrespective of whether they have a logical
meaning.
wirelist_of_gate :: Gate -> [Wire] Source #
Like wires_of_gate
, except return a list of wires.
Dynamic arities
type ExtArity = XIntMap Wiretype Source #
Recall that an Arity
is a set of typed wires, and it determines
the external interfaces at which circuits and gates can be
connected. The type ExtArity
stores the same information as the
type Arity
, but in a format that is more optimized for efficient
updating. Additionally, it also stores the set of wires ever used.
arity_append_safe :: Gate -> ExtArity -> ExtArity Source #
Check whether the given gate is well-formed and can be legally applied in the context of the given arity. If successful, return the updated arity resulting from the gate application. If unsuccessful, raise an error. Properties checked are:
- that each gate has non-overlapping inputs, including controls;
- that each gate has non-overlapping outputs, including controls;
- that the inputs of the gate (including controls) are actually present in the current arity;
- that the types of the inputs (excluding controls) match those of the current arity;
- that the outputs of the gate (excluding controls) don't conflict with any wires already existing in the current arity.
arity_append_unsafe :: Gate -> ExtArity -> ExtArity Source #
Like arity_append
, but without type checking. This is
potentially faster, but should only used in applications that have
already been thoroughly tested or type-checked.
arity_append :: Gate -> ExtArity -> ExtArity Source #
For now, we disable run-time type checking, because we have not
yet implemented run-time types properly. Therefore, we define
arity_append
to be a synonym for arity_append_unsafe
.
arity_empty :: ExtArity Source #
Return an empty arity.
arity_unused_wire :: ExtArity -> Wire Source #
Return a wire unused in the current arity.
arity_unused_wires :: Int -> ExtArity -> [Wire] Source #
Return the next k wires unused in the current arity.
arity_alloc :: Wiretype -> ExtArity -> (Wire, ExtArity) Source #
Add a new typed wire to the current arity. This returns a new wire and the updated arity.
arity_of_extarity :: ExtArity -> Arity Source #
Convert an extended arity to an ordinary arity.
n_of_extarity :: ExtArity -> Int Source #
Return the smallest wire id nowhere used in the circuit.
Circuit abstraction
type Circuit = (Arity, [Gate], Arity, Int) Source #
A completed circuit (a1,gs,a2,n) has an input arity a1, a list of gates gs, and an output arity a2. We also record n, the total number of wires used by the circuit. Because wires are allocated consecutively, this means that the wire id's used are [0..n-1].
wirelist_of_circuit :: Circuit -> [Wire] Source #
Return the set of all the wires in a circuit.
Reversing low-level circuits
reverse_gatelist :: [Gate] -> [Gate] Source #
Reverse a gate list.
reverse_circuit :: Circuit -> Circuit Source #
Reverse a circuit. Throw an error if the circuit is not reversible.
NoControlFlag on low-level circuits
circuit_to_nocontrol :: Circuit -> Circuit Source #
Set the NoControlFlag
on all gates of a circuit.
Ordered circuits
An ordered circuit is a Circuit
together with an ordering on
(usually all, but potentially a subset of) the input and output
endpoints.
This extra information is required when a circuit is used within a
larger circuit (e.g. via a Subroutine
gate), to identify which wires
of the sub-circuit should be bound to which wires of the surrounding
circuit.
reverse_ocircuit :: OCircuit -> OCircuit Source #
Reverse an OCircuit
. Throw an error if the circuit is not reversible.
Annotated circuits
data CircuitTypeStructure a Source #
One often wants to consider the inputs and outputs of a circuit as
more structuredtyped than just lists of bitsqubits; for instance,
a list of six qubits could be structured as a pair of triples, or a
triple of pairs, or a six-bit QDInt
.
While for the most part this typing information is not included in low-level circuits, we need to consider it in hierarchical circuits, so that the information stored in a subroutine is sufficient to call the subroutine in a typed context.
Specifically, the extra information needed consists of functions to destructure the input/output data as a list of typed wires, and restructure such a list of wires into a piece of data of the appropriate type.
CircuitTypeStructure (a -> ([Wire], Arity)) (([Wire], Arity) -> a) |
id_CircuitTypeStructure :: CircuitTypeStructure ([Wire], Arity) Source #
The trivial CircuitTypeStructure
on ([
.Wire
],Arity
)
destructure_with :: CircuitTypeStructure a -> a -> ([Wire], Arity) Source #
Use a CircuitTypeStructure
to destructure a piece of (suitably
typed) data into a list of typed wires.
structure_with :: CircuitTypeStructure a -> ([Wire], Arity) -> a Source #
Use a CircuitTypeStructure
to structure a list of typed wires
(of the appropriate length/arity) into a piece of structured data.
Boxed circuits
data TypedSubroutine Source #
A typed subroutine consists of:
- a low-level circuit, ordered to allow binding of incoming and outgoing wires;
- functions for structuring/destructuring the inputs and outputs to and from lists of wires (these functions being dynamically typed, since the input/output type may vary between subroutines);
- a
ControllableFlag
, recording whether the circuit is controllable.
(Typeable a, Typeable b) => TypedSubroutine OCircuit (CircuitTypeStructure a) (CircuitTypeStructure b) ControllableFlag |
circuit_of_typedsubroutine :: TypedSubroutine -> Circuit Source #
Extract just the Circuit
from a TypedSubroutine
.
type Namespace = Map BoxId TypedSubroutine Source #
A name space is a map from names to subroutine bindings. These subroutines can reference each other; it is the programmer’s responsibility to ensure there is no circular dependency, and no clash of names.
namespace_empty :: Namespace Source #
The empty namespace.
showNames :: Namespace -> String Source #
A function to display the names of all the subroutines in a Namespace
.
type BCircuit = (Circuit, Namespace) Source #
A boxed circuit is a distinguished simple circuit (analogous to a “main” function) together with a namespace.
Ordered circuits
Basic functions lifted to boxed circuits
reverse_bcircuit :: BCircuit -> BCircuit Source #
Reverse a simple boxed circuit, or throw an error if not reversible.
The ReadWrite monad
The ReadWrite
monad encapsulates the interaction with a (real
or simulated) low-level quantum device.
The ReadWrite
monad describes a standard read-write
computation, here specialized to the case where writes are Gate
s,
prompts are Bit
s, and reads are Bool
s. Thus, a
read-write computation can do three things:
RW_Return a | |
RW_Write !Gate (ReadWrite a) | |
RW_Read !Wire (Bool -> ReadWrite a) | |
RW_Subroutine BoxId TypedSubroutine (ReadWrite a) |
readwrite_wrap :: ReadWrite a -> ReadWrite ([Gate], a) Source #
Transforms a read-write computation into one that behaves identically, but also returns the list of gates generated.
This is used as a building block, for example to allow a read-write computation to be run in a simulator while simultaneously using a static backend to print the list of generated gates.
readwrite_unwind_static :: ErrMsg -> ReadWrite a -> a Source #
gatelist_of_readwrite :: ErrMsg -> ReadWrite a -> Namespace -> ([Gate], Namespace, a) Source #
Turn a static read-write computation into a list of gates, while
also updating a namespace. "Static" means that the computation
may not contain any RW_Read
operations. If it does, the message
"dynamic lifting" is passed to the given error handler.
Important usage note: This function returns a triple (gates, ns, x). The list of gates is generated lazily, and can be consumed one gate at a time. However, the values ns and x are only computed at the end of the computation. Any function using them should not apply a strict pattern match to ns or x, or else the whole list of gates will be generated in memory. For example, the following will blow up the memory:
(gates, ns, (a, n, x)) = gatelist_of_readwrite errmsg comp
whereas the following will work as intended:
(gates, ns, ~(a, n, x)) = gatelist_of_readwrite errmsg comp
Dynamic boxed circuits
bcircuit_of_static_dbcircuit :: ErrMsg -> DBCircuit a -> (BCircuit, a) Source #
Convert a dynamic boxed circuit to a static boxed circuit. The dynamic boxed circuit may not contain any dynamic liftings, since these cannot be performed in a static setting. In case any output liftings are encountered, try to issue a meaningful error via the given stub error message.