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 [5]

*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.

## Pauli gates

I q X q Y q Z q

## Hadamard gate

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 | Hadamard 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")] instructions = [(Hadamard a), (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")] instructions = [(Hadamard a), (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 [5] 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 hadamardRotateXYZ rotation = let parameters@[Left a, Left b, Right r, Left z] = [Left (MetaQubitRegister "a"), Left (MetaQubitRegister "b"), Right (MetaRegister "r"), Left (MetaQubitRegister "z")] instructions = [(Hadamard a), (MeasureOut a r)] ++ (ifC "HROTXYZTHEN0" "HROTXYZEND0" r [(RX (ComplexConstant rotation) z)] ([(Hadamard b), (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.