# High Level Quantum Assembly using Haskell

I recently watched an interesting video on the Computerphile YouTube channel by Robert Smith of Rigetti Computing about their quantum computer instruction set. You can read about their instruction set here.

I don’t know anything about quantum physics or quantum computers but after reading their paper, I realized that it comes down to executing a set of assembly instructions with two kinds of registers, either quantum registers or classical registers. That seems easy enough to play around with in Haskell!

# Quantum registers

Let’s make some qubit registers:

```data Quantum = QubitRegister Int |
MetaQubitRegister String```

QubitRegisters are indexed by an integer. We’ll also need a MetaQubitRegister for circuit macros, I’ll talk about those soon.

Since this is a high level assembler, its output will be low level assembly. In order to generate the low level instruction for a qubit register, we’ll simply make Quantum an instance of the Show typeclass:

```instance Show Quantum where
show (QubitRegister i) = show i
show (MetaQubitRegister s) = s```

Quantum registers are simply printed out as integers. For example here’s how you would call the CNot instruction on register 5 and 3:

`CNOT 5 3`

All Quantum registers hold a single Qubit.

Classical registers are handled similarly:

```data Classical a = Register Int |
Range Int Int |
RealConstant a |
ComplexConstant (Complex a) |
MetaRegister String```

Classical arguments in Quil can include classical numeric constants, like RealConstant and ComplexConstant. These are used as arguments to some of the Quil instructions.

Here’s how Classical is an instance of Show:

```instance (Floating a, Show a, Ord a) => Show (Classical a) where
show (Register i) = "[" ++ (show i) ++ "]"
show (Range i j) = "[" ++ (show i) ++ "-" ++ (show j) ++ "]"
show (RealConstant r) = show r
show (ComplexConstant (p :+ q))
| q >= 0 = (show p) ++ "+" ++ (show q) ++ "i"
| otherwise = (show p) ++ (show q) ++ "i"
show (MetaRegister s) = s```

Classical registers are printed out in square brackets. Here’s an example of the Classical register 5 used in Quil’s not instruction:

`NOT `

Classical constants can also be used as parameters of quantum instructions. In the following example, the Classical complex constant 0.9009688679-0.4338837391i is used as an argument to the instruction RX along with the quantum register 3:

`RX(0.9009688679-0.4338837391i) 3`

I’m going to assume that Classical “registers” also hold only a single bit but multiple “registers” in a Range can hold integers, real numbers, and complex numbers using some standard format.

Here’s another example of RX using the Range [64-127]:

`RX([64-127]) 3`

Notice how Classical and Quantum are separate types, this is useful for type checking the arguments to Quil assembly instructions.

# Quantum instructions

Next up, we need some assembly instructions. The Quil instruction set is split into instructions which operate on Qubits and instructions which operate on regular bits.

Note: In the following sections, q represents a quantum register, c represents a classical register or constant.

```I q
X q
Y q
Z q```

`H q`

## Phase gates

```PHASE(c) q
S q
T q```

## Controlled-phase gates

```CPHASE00(c) q q
CPHASE01(c) q q
CPHASE10(c) q q
CPHASE(c) q q```

## Cartesian rotation gates

```RX(c) q
RY(c) q
RZ(c) q```

## Controlled-X gates

```CNOT q q
CCNOT q q q q```

## Swap gates

```PSWAP(c) q q
SWAP q q
ISWAP q q
CSWAP q q q q```

There are also two special instructions which control the quantum state, Measure, which reads a qubit and optionally write its value into a classical register, and reset, which somehow resets all of the qubits.

```MEASURE q
MEASURE q c
RESET```

I have no idea what any of these do, but we can make a type to represent these pretty easily:

```data Instruction a
= PauliI Quantum | --Quantum instructions
PauliX Quantum |
PauliY Quantum |
PauliZ Quantum |
Phase (Classical a) Quantum |
PhaseS Quantum |
PhaseT Quantum |
CPhase00 (Classical a) Quantum Quantum |
CPhase01 (Classical a) Quantum Quantum |
CPhase10 (Classical a) Quantum Quantum |
CPhase (Classical a) Quantum Quantum |
RX (Classical a) Quantum |
RY (Classical a) Quantum |
RZ (Classical a) Quantum |
CNot Quantum Quantum |
CCNot Quantum Quantum Quantum Quantum |
PSwap (Classical a) Quantum Quantum |
Swap Quantum Quantum |
ISwap Quantum Quantum |
CSwap Quantum Quantum Quantum Quantum |
Measure Quantum |
MeasureOut Quantum (Classical a) |
Reset |```

We’ll add the classical instructions to the Instruction type too:

```      Halt | --Classical instructions
Jump String |
JumpWhen String (Classical a) |
JumpUnless String (Classical a) |
Label String |
Nop |
IFalse (Classical a) |
ITrue (Classical a) |
INot (Classical a) |
IAnd (Classical a) (Classical a) |
IOr (Classical a) (Classical a) |
Move (Classical a) (Classical a) |
Exchange (Classical a) (Classical a) |
Pragma String |```

Finally, the Quil assembly language supports macros called “circuits”. I’ll explain how I made a type to represent a circuit below, but for now let’s add an instruction to define a circuit and to call a circuit:

```      DefCircuit (Circuit a) |
CallCircuit (Circuit a) [Either Quantum (Classical a)]```

I’m using the Either metatype here to enable circuits to be called with a list of either Quantum or Classical arguments.

# Assembling quantum instructions

Now all we need to do to assemble a program for a Quil machine is to make Instruction an instance of the Show typeclass. Since we’ve already defined how to show Quantum and Classical registers, we can output these using the show command, concantenating them with the instruction strings. For example, here’s how to define show for rotation gates:

```instance (Floating a, Show a, Ord a) => Show (Instruction a) where
...
show (RX c q) = "RX(" ++ (show c) ++ ") " ++ (show q)
show (RY c q) = "RY(" ++ (show c) ++ ") " ++ (show q)
show (RZ c q) = "RZ(" ++ (show c) ++ ") " ++ (show q)
...```

Now we can print a RX gate instruction by calling putStrLn like this:

`putStrLn (show \$ RX (ComplexConstant (0.9009688679 :+ (-0.4338837391))) (QubitRegister 1))`

The function above will print out the following assembly instruction to the terminal:

`RX(0.9009688679-0.4338837391i) 1`

The rest of the Quil instructions are just as easily shown, except for macros:

```instance (Floating a, Show a, Ord a) => Show (Instruction a) where
...
show (DefCircuit c) = case showDefCircuit c of
Left e -> e
Right c -> c
show (CallCircuit c arguments) = case showCallCircuit c arguments of
Left e -> e
Right c -> c
```

These instructions are shown by showDefCircuit and showCallCircuit. It’s possible to get a type-mismatch in these functions, so I’m using Either to track whether there was an error.

# Quantum circuits

In order to define a circuit, we need a Circuit type:

`data Circuit a = Circuit String [Either Quantum (Classical a)] [Instruction a]`

A Circuit has a name String, a list of Either Quantum or Classical parameters, and a list of Instructions.

For convenience I created a type synonym to hold the current text definition of the circuit:

`type CircuitText = String`

showDefCircuit prints the circuit definition:

```showDefCircuit :: (Floating a, Show a, Ord a) => Circuit a -> Either String CircuitText
showDefCircuit (Circuit name _ []) = Left ("Error (showDefCircuit): No instructions in circuit " ++ name)
showDefCircuit (Circuit name parameters instructions) = (Right ("DEFCIRCUIT " ++ (fmap toUpper name))) >>= (defCircuitParameters parameters instructions)```

It shows DEFCIRCUIT followed by the circuit name and then calls defCircuitParameters. Notice that if there are no instructions in the circuit, an error will be displayed. Since we’re using the Either monad, we use >>= bind to pass the current result to the next function, or abort if an error was found.

Here’s the definition of defCircuitParameters:

```defCircuitParameters :: (Floating a, Show a, Ord a) => [Either Quantum defCircuitParameters :: (Floating a, Show a, Ord a) => [Either Quantum (Classical a)] -> [Instruction a] -> CircuitText -> Either String CircuitText
defCircuitParameters [] instructions circuitText = (Right (circuitText ++ ":")) >>= (defCircuitInstructions instructions)
defCircuitParameters (Left r@(MetaQubitRegister _) : parameters) instructions circuitText = (Right (circuitText ++ " " ++ (show r))) >>= (defCircuitParameters parameters instructions)
defCircuitParameters (Right r@(MetaRegister _) : parameters) instructions circuitText = (Right (circuitText ++ " " ++ (show r))) >>= (defCircuitParameters parameters instructions)
defCircuitParameters p _ _ = Left ("Error (defCircuitParameters): Type mismatch for parameter " ++ (show p))```

Circuit parameters are shown in order, followed by a : character and a newline.

Notice that only Left r@(MetaQubitRegister _) and Right r@(MetaRegister _) are pattern matched. This ensures that the function will evaluate to a Left error if we pass anything other than a meta-register in as a circuit parameter. For example, the following will result in an error message:

`showDefCircuit (Circuit "foo" [Left (QubitRegister 3)] [...])`

because QubitRegister 3 is a literal qubit register, not a placeholder for a qubit register.

Finally, defCircuitInstructions is called. Since there are a lot of instructions and they’re basically all the same format, I’ll just show how the RX instruction is defined:

```defCircuitInstructions :: (Floating a, Show a, Ord a) => [Instruction a] -> CircuitText -> Either String CircuitText
...
defCircuitInstructions (instruction@(RX (RealConstant _) (MetaQubitRegister _)) : instructions) circuitText = circuitInstruction (instruction : instructions) circuitText
defCircuitInstructions (instruction@(RX (ComplexConstant _) (MetaQubitRegister _)) : instructions) circuitText = circuitInstruction (instruction : instructions) circuitText
defCircuitInstructions (instruction@(RX (MetaRegister _) (MetaQubitRegister _)) : instructions) circuitText = circuitInstruction (instruction : instructions) circuitText```

Since RX can take a constant or register as an argument, I’m allowing defCircuitInstructions to pattern match against either RealConstant and ComplexConstant in addition to a MetaRegister for RX. The second parameter of RX is a qubit register, so we ensure that a MetaQubitRegister was used as an argument to RX in the Circuit definition.

Again, if any literal registers are passed into the circuit, a type mismatch error will be thrown at compile time.

defCircuitInstructions just calls circuitInstruction to show the instruction:

```circuitInstruction :: (Floating a, Show a, Ord a) => [Instruction a] -> CircuitText -> Either String CircuitText
circuitInstruction (instruction : instructions) circuitText = (Right (circuitText ++ "\n " ++ (show instruction))) >>= (defCircuitInstructions instructions)```

showCallCircuit is similar:

```showCallCircuit :: (Floating a, Show a, Ord a) => Circuit a -> [Either Quantum (Classical a)] -> Either String CircuitText
showCallCircuit (Circuit name _ _) [] = Right name
showCallCircuit (Circuit name parameters _) arguments = (Right name) >>= callCircuitArguments parameters arguments```

callCircuitArguments shows the arguments to the circuit call:

```callCircuitArguments :: (Floating a, Show a, Ord a) => [Either Quantum (Classical a)] -> [Either Quantum (Classical a)] -> String -> Either String String
callCircuitArguments [] [] circuitText = Right circuitText
callCircuitArguments (Left (MetaQubitRegister _) : parameters) (Left q@(QubitRegister _) : arguments) circuitText = (Right (circuitText ++ " " ++ (show q))) >>= callCircuitArguments parameters arguments
callCircuitArguments (Left (MetaQubitRegister _) : parameters) (Left q@(MetaQubitRegister _) : arguments) circuitText = (Right (circuitText ++ " " ++ (show q))) >>= callCircuitArguments parameters arguments
callCircuitArguments (Right (RealConstant _) : parameters) (Right c@(RealConstant _) : arguments) circuitText = (Right (circuitText ++ " " ++ (show c))) >>= callCircuitArguments parameters arguments
callCircuitArguments (Right (ComplexConstant _) : parameters) (Right c@(ComplexConstant _) : arguments) circuitText = (Right (circuitText ++ " " ++ (show c))) >>= callCircuitArguments parameters arguments
callCircuitArguments (Right (MetaRegister _) : parameters) (Right r@(Register _) : arguments) circuitText = (Right (circuitText ++ " " ++ (show r))) >>= callCircuitArguments parameters arguments
callCircuitArguments (Right (MetaRegister _) : parameters) (Right r@(Range _ _) : arguments) circuitText = (Right (circuitText ++ " " ++ (show r))) >>= callCircuitArguments parameters arguments
callCircuitArguments (Right (MetaRegister _) : parameters) (Right r@(MetaRegister _) : arguments) circuitText = (Right (circuitText ++ " " ++ (show r))) >>= callCircuitArguments parameters arguments
callCircuitArguments _ (a : arguments) _ = Left ("Error (callCircuitArguments): Type mismatch for argument " ++ (show a))```

Again, pattern matching ensures the correctness of this code. If the Circuit has a Left (MetaQubitRegister _) as its first parameter, then the corresponding argument must be a Left q@(QubitRegister _). It’s impossible to pass a classical register as the first argument, if you do, an error message will result.

# Building a circuit

Now that we know how a Circuit definition and call are printed, it’s useful to look at a definition of a simple circuit. Here’s how to define the BELL circuit which is defined in the Quil paper:

```testCircuit :: (Floating a, Show a, Ord a) => Circuit a
testCircuit = let parameters@[Left a, Left b] = [Left (MetaQubitRegister "a"), Left (MetaQubitRegister "b")]
(CNot a b)]
in Circuit "BELL" parameters instructions```

There are two benefits to using a function like this to build a Circuit.

Firstly, we know that the parameters in the DEFCIRCUIT line must be the same parameters used in the calls to H and CNOT; it’s impossible to accidentally use an undefined parameter name in the circuit. For example, we know for sure that this code won’t be produced by show DefCircuit:

```DEFCIRCUIT BELL a b:
H x
CNOT a b```

Because “x” isn’t in the parameters list.

Secondly, the parameters a and b are type-checked as MetaQubitRegisters, so it’s impossible to accidentally pass a classical register or constant into the BELL circuit.

# Conclusion

With all of the above we can define a silly quantum program which is certainly not going to actually do anything actually practical but will compile correctly:

```import Data.Complex
import Register
import Instruction

bellCircuit :: (Floating a, Show a, Ord a) => Circuit a
bellCircuit = let parameters@[Left a, Left b] = [Left (MetaQubitRegister "a"), Left (MetaQubitRegister "b")]
(CNot a b)]
in Circuit "BELL" parameters instructions

testRXCircuit :: (Floating a, Show a, Ord a) => Circuit a
testRXCircuit = let parameters@[Left a] = [Left (MetaQubitRegister "a")]
instructions = [(RX (ComplexConstant (5.0 :+ 10.0)) a)]
in Circuit "TESTRX" parameters instructions

compile :: IO ()
compile = putStrLn "Compiling quantum executable" >>
putStrLn (show \$ CNot (QubitRegister 0) (QubitRegister 1)) >>
putStrLn (show \$ PSwap (ComplexConstant (5.0 :+ (-3.2))) (QubitRegister 0) (QubitRegister 1)) >>
putStrLn (show \$ Measure (QubitRegister 4)) >>
putStrLn (show \$ MeasureOut (QubitRegister 4) (Register 5)) >>
putStrLn (show \$ DefCircuit bellCircuit) >>
putStrLn (show \$ CallCircuit bellCircuit [Left (QubitRegister 5), Left (QubitRegister 3)]) >>
putStrLn (show \$ DefCircuit testRXCircuit)```

The output of the compile function is this Quil assembly:

```CNOT 0 1
PSWAP(5.0-3.2i) 0 1
MEASURE 4
MEASURE 4 
DEFCIRCUIT BELL a b:
H a
CNOT a b

BELL 5 3
DEFCIRCUIT TESTRX a:
RX(5.0+10.0i) a```

Since we’re still working with Haskell, we can benefit from all of our usual features like maps, folds, and monads! For example, this function:

``` foldl (\a x -> a >> putStrLn (show x))
(return ())
(fmap (\x -> CallCircuit bellCircuit x)
(fmap (\(x, y) -> [(Left (QubitRegister x)), (Left (QubitRegister y))])
(zip [0..5] [1..6])))```

prints the following instructions:

```BELL 0 1
BELL 1 2
BELL 2 3
BELL 3 4
BELL 4 5
BELL 5 6```

As one final example, here’s a high level circuit with a nested if statement:

```hadamardRotateXYZ :: (Floating a, Show a, Ord a) => Complex a -> Circuit a
= let parameters@[Left a, Left b, Right r, Left z] = [Left (MetaQubitRegister "a"), Left (MetaQubitRegister "b"), Right (MetaRegister "r"), Left (MetaQubitRegister "z")]
(MeasureOut a r)] ++
(ifC "HROTXYZTHEN0" "HROTXYZEND0"
r
[(RX (ComplexConstant rotation) z)]
(MeasureOut b r)] ++
(ifC "HROTXYZTHEN1" "HROTXYZEND1"
r
[(RY (ComplexConstant rotation) z)]
[(RZ (ComplexConstant rotation) z)])))
in Circuit "HROTXYZ" parameters instructions
```

which produces the following assembly code:

```DEFCIRCUIT HROTXYZ a b r z:
H a
MEASURE a r
JUMP-WHEN @HROTXYZTHEN0 r
H b
MEASURE b r
JUMP-WHEN @HROTXYZTHEN1 r
RZ(0.70710678118+0.70710678118i) z
JUMP @HROTXYZEND1
LABEL @HROTXYZTHEN1
RY(0.70710678118+0.70710678118i) z
LABEL @HROTXYZEND1
JUMP @HROTXYZEND0
LABEL @HROTXYZTHEN0
RX(0.70710678118+0.70710678118i) z
LABEL @HROTXYZEND0
```

One notable deficiency of the HROTXYZ circuit above is that it includes unnecessary jumps. This could be solved by using an optimizing compiler and a full high level language.

High level quantum assembly in Haskell was a pretty fun weekend project and probably the best example I’ve ever written of how Haskell’s built in type checking can be useful in a specialized problem domain.

The source code for this project is available at https://github.com/WhatTheFunctional/Hasquil.

Some time in future I’d like to define a functional quantum high level language, but I’ve never written a compiler for a functional language, so I’ll have to learn how to do that first.