diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,9 @@ # Revision history for quil +## 0.2.0.0 -- 2017-12-19 + +* added types for Quil + ## 0.1.7.5 -- 2017-12-19 * added example usage diff --git a/ReadMe.md b/ReadMe.md --- a/ReadMe.md +++ b/ReadMe.md @@ -12,7 +12,7 @@ This example creates a wavefunction for the [Bell state](https://en.wikipedia.org/wiki/Bell_state) and then performs a measurement on its highest qubit. > import Control.Monad.Random (evalRandIO) - > import Data.Qubit ((^^*), groundState) + > import Data.Qubit ((^^*), groundState, measure) > import Data.Qubit.Gate (H, CNOT) > -- Construct the Bell state. diff --git a/haquil.cabal b/haquil.cabal --- a/haquil.cabal +++ b/haquil.cabal @@ -1,5 +1,5 @@ name : haquil -version : 0.1.7.5 +version : 0.2.1.5 synopsis : A Haskell implementation of the Quil instruction set for quantum computing. description : This Haskell library implements the Quil language for quantum computing, as specified in "A Practical Quantum Instruction Set Architecture" \. @@ -12,7 +12,7 @@ homepage : https://bitbucket.org/functionally/haquil bug-reports : https://bwbush.atlassian.net/projects/HQUIL/issues/ -package-url : https://bitbucket.org/functionally/quil/downloads/haquil-0.1.7.5.tar.gz +package-url : https://bitbucket.org/functionally/quil/downloads/haquil-0.2.1.5.tar.gz category : Language stability : Unstable @@ -29,12 +29,18 @@ library exposed-modules : Data.Qubit Data.Qubit.Gate + Language.Quil.Execute + Language.Quil.Types other-modules : Data.Int.Util hs-source-dirs : src - build-depends : base >= 4.9 && < 4.10 - , hTensor - , MonadRandom - , vector + build-depends : base < 5 + , bv >= 0.4.1 + , data-binary-ieee754 >= 0.4.4 + , data-default >= 0.7.1 + , hTensor >= 0.9.1 + , MonadRandom >= 0.5.1 + , random >= 1.1 + , vector >= 0.12.0 exposed : True buildable : True default-language : Haskell2010 @@ -44,9 +50,13 @@ main-is : Test.hs hs-source-dirs : src build-depends : base + , bv + , data-binary-ieee754 + , data-default , hTensor , MonadRandom , QuickCheck + , random , template-haskell , vector type : exitcode-stdio-1.0 diff --git a/src/Data/Int/Util.hs b/src/Data/Int/Util.hs --- a/src/Data/Int/Util.hs +++ b/src/Data/Int/Util.hs @@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- -- Module : $Header$ --- Copyright : (c) 2017 Brian W Bush +-- Copyright : (c) 2017-18 Brian W Bush -- License : MIT -- -- Maintainer : Brian W Bush diff --git a/src/Data/Qubit.hs b/src/Data/Qubit.hs --- a/src/Data/Qubit.hs +++ b/src/Data/Qubit.hs @@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- -- Module : $Header$ --- Copyright : (c) 2017 Brian W Bush +-- Copyright : (c) 2017-18 Brian W Bush -- License : MIT -- -- Maintainer : Brian W Bush diff --git a/src/Data/Qubit/Gate.hs b/src/Data/Qubit/Gate.hs --- a/src/Data/Qubit/Gate.hs +++ b/src/Data/Qubit/Gate.hs @@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- -- Module : $Header$ --- Copyright : (c) 2017 Brian W Bush +-- Copyright : (c) 2017-18 Brian W Bush -- License : MIT -- -- Maintainer : Brian W Bush diff --git a/src/Language/Quil/Execute.hs b/src/Language/Quil/Execute.hs new file mode 100644 --- /dev/null +++ b/src/Language/Quil/Execute.hs @@ -0,0 +1,252 @@ +----------------------------------------------------------------------------- +-- +-- Module : $Header$ +-- Copyright : (c) 2017-18 Brian W Bush +-- License : MIT +-- +-- Maintainer : Brian W Bush +-- Stability : Stable +-- Portability : Portable +-- +-- | Executing Quil programs. +-- +----------------------------------------------------------------------------- + + +{-# LANGUAGE RecordWildCards #-} + + +module Language.Quil.Execute ( +-- * Execution + runProgram +, runProgramWithStdGen +, runProgramWithStdRandom +, executeInstructions +, executeInstruction +-- * Compilation +, compileGate +, compileExpression +) where + + +import Control.Monad (foldM) +import Control.Monad.Random.Lazy (Rand, RandomGen, evalRand, evalRandIO) +import Data.Bits (clearBit, complementBit, setBit, testBit) +import Data.BitVector (BV) +import Data.Complex (Complex((:+))) +import Data.Function (on) +import Data.Qubit (Operator, Wavefunction, (^*), groundState, measure, qubitsOperator, wavefunctionOrder) +import Language.Quil.Types (Arguments, BitData, Expression(..), Instruction(..), Machine(..), Number, Parameter(..), Parameters, QBit, complexFromBitVector, doubleFromBitVector) +import System.Random (StdGen) + +import qualified Data.Qubit.Gate as G +import qualified Data.Vector as V ((!), elemIndex, empty) +import qualified Language.Quil.Types as Q (machine) + + +-- | Create an action to run a program, starting from the ground state. +runProgramWithStdGen :: StdGen -- ^ The random number generator. + -> Int -- ^ The number of qubits. + -> [BitData] -- ^ The classical bits. + -> [Instruction] -- ^ The instructions + -> Machine -- ^ The resulting state of the machine. +runProgramWithStdGen stdGen n cstate' instructions = runProgram n cstate' instructions `evalRand` stdGen + + +-- | Run a program, starting from the ground state and using a particular random-number generator. +runProgramWithStdRandom :: Int -- ^ The number of qubits. + -> [BitData] -- ^ The classical bits. + -> [Instruction] -- ^ The instructions + -> IO Machine -- ^ Action for the resulting state of the machine. +runProgramWithStdRandom n cstate' instructions = evalRandIO $ runProgram n cstate' instructions + + +-- | Run a program, starting from the ground state and using the global random number generator. +runProgram :: RandomGen g + => Int -- ^ The number of qubits. + -> [BitData] -- ^ The classical bits. + -> [Instruction] -- ^ The instructions + -> Rand g Machine -- ^ Action for the resulting state of the machine. +runProgram n cstate' instructions = executeInstructions instructions $ Q.machine n cstate' + + +-- | Execute a series of instructions. +executeInstructions :: RandomGen g + => [Instruction] -- ^ The instructions + -> Machine -- ^ The state of the machine. + -> Rand g Machine -- ^ Action for the resulting state of the machine. +executeInstructions = flip $ foldM (flip executeInstruction) + + +-- | Execute an instruction. +executeInstruction :: RandomGen g + => Instruction -- ^ The instruction. + -> Machine -- ^ The state of the machine. + -> Rand g Machine -- ^ Action for the resulting state of the machine. + +executeInstruction (COMMENT _) = return + +executeInstruction RESET = onQubits $ groundState . wavefunctionOrder + +executeInstruction (I index) = onQubits (G.i index ^*) +executeInstruction (X index) = onQubits (G.x index ^*) +executeInstruction (Y index) = onQubits (G.y index ^*) +executeInstruction (Z index) = onQubits (G.z index ^*) +executeInstruction (H index) = onQubits (G.h index ^*) +executeInstruction (S index) = onQubits (G.s index ^*) +executeInstruction (T index) = onQubits (G.t index ^*) + +executeInstruction (CNOT index index') = onQubits (G.cnot index index' ^*) +executeInstruction (SWAP index index') = onQubits (G.swap index index' ^*) +executeInstruction (ISWAP index index') = onQubits (G.iswap index index' ^*) +executeInstruction (CZ index index') = onQubits (G.cz index index' ^*) + +executeInstruction (CCNOT index index' index'') = onQubits (G.ccnot index index' index'' ^*) +executeInstruction (CSWAP index index' index'') = onQubits (G.cswap index index' index'' ^*) + +executeInstruction (PHASE theta index) = onQubits' (\theta' -> (G.phase (ensureReal theta') index ^*)) theta +executeInstruction (RX theta index) = onQubits' (\theta' -> (G.rx (ensureReal theta') index ^*)) theta +executeInstruction (RY theta index) = onQubits' (\theta' -> (G.ry (ensureReal theta') index ^*)) theta +executeInstruction (RZ theta index) = onQubits' (\theta' -> (G.rz (ensureReal theta') index ^*)) theta + +executeInstruction (CPHASE00 theta index index') = onQubits' (\theta' -> (G.cphase00 (ensureReal theta') index index' ^*)) theta +executeInstruction (CPHASE01 theta index index') = onQubits' (\theta' -> (G.cphase01 (ensureReal theta') index index' ^*)) theta +executeInstruction (CPHASE10 theta index index') = onQubits' (\theta' -> (G.cphase10 (ensureReal theta') index index' ^*)) theta +executeInstruction (CPHASE theta index index') = onQubits' (\theta' -> (G.cphase (ensureReal theta') index index' ^*)) theta +executeInstruction (PSWAP theta index index') = onQubits' (\theta' -> (G.pswap (ensureReal theta') index index' ^*)) theta + +executeInstruction DEFGATE {} = unimplemented "DEFGATE" +executeInstruction USEGATE {} = unimplemented "DEFGATE" +executeInstruction DEFCIRCUIT {} = unimplemented "DEFCIRCUIT" +executeInstruction USECIRCUIT {} = unimplemented "DEFCIRCUIT" + +executeInstruction (MEASURE index address) = + \machine@Machine{..} -> + do + ([(_, b)], qstate') <- measure [index] qstate + noop + machine + { + qstate = qstate' + , cstate = maybe id (setBit' (toEnum $ fromEnum b)) address cstate + } + +executeInstruction HALT = fmap (\machine -> machine {halted = True}) . noop +executeInstruction WAIT = noop + +executeInstruction LABEL {} = unimplemented "LABEL" +executeInstruction JUMP {} = unimplemented "JUMP" +executeInstruction JUMP_WHEN {} = unimplemented "JUMP_WHEN" +executeInstruction JUMP_UNLESS {} = unimplemented "JUMP_UNLESS" + +executeInstruction (FALSE address) = onBits (setBit' False address) +executeInstruction (TRUE address) = onBits (setBit' True address) +executeInstruction (NOT address) = onBits (`complementBit` address) + +executeInstruction (AND address address') = onBits (\bv -> setBit' (bv `testBit` address && bv `testBit` address') address' bv) +executeInstruction (OR address address') = onBits (\bv -> setBit' (bv `testBit` address || bv `testBit` address') address' bv) +executeInstruction (MOVE address address') = onBits (\bv -> setBit' (bv `testBit` address ) address' bv) +executeInstruction (EXCHANGE address address') = onBits (\bv -> setBit' (bv `testBit` address) address' $ setBit' (bv `testBit` address') address bv) + +executeInstruction NOP = noop + +executeInstruction (INCLUDE _) = unimplemented "INCLUDE" +executeInstruction (PRAGMA _) = noop + + +-- | Ensure a complex number is real. +ensureReal :: Number -- ^ The number. + -> Double -- ^ The double, or an error. +ensureReal (x :+ 0) = x +ensureReal _ = error "Built-in gate must have real argument." + + +-- | Report that an instruction has not yet been implemented. +unimplemented :: String -- ^ The name of the instruction. + -> a -- ^ THe error. +unimplemented instruction = error $ "The " ++ instruction ++ " instruction has not yet been implemented." + + +-- | Just increment the progrma counter. +noop :: RandomGen g + => Machine -- ^ The machine. + -> Rand g Machine -- ^ Action for the resulting state of the machine. +noop machine@Machine{..} = + if halted + then error "The machine has halted." + else return machine { counter = counter + 1 } + + +-- | Transform the wafefunction. +onQubits :: RandomGen g + => (Wavefunction -> Wavefunction) -- ^ The transformation of the wavefunction. + -> Machine -- ^ The machine. + -> Rand g Machine -- ^ Action for the resulting state of the machine. +onQubits transition machine@Machine{..} = noop machine { qstate = transition qstate } + + +-- | Transofrm the wavefunction. +onQubits' :: RandomGen g + => (Number -> Wavefunction -> Wavefunction) -- ^ The parameterized transformation of the wavefunction. + -> Parameter -- ^ The parameter. + -> Machine -- ^ The machine. + -> Rand g Machine -- ^ Action for the resulting state of the machine. +onQubits' _ (DynamicParameter _ Nothing) _ = error "A single bit cannot be used as an input parameter for a gate." +onQubits' transition (DynamicParameter address (Just address')) machine@Machine{..} + | address + 63 == address' = onQubits (transition $ doubleFromBitVector address cstate :+ 0) machine + | address + 127 == address' = onQubits (transition $ complexFromBitVector address cstate ) machine + | otherwise = error "A number must consist of 64 or 128 consecutive bits." +onQubits' transition (Expression expression) machine = onQubits (transition $ compileExpression V.empty expression V.empty) machine + + +-- Transform the classical bis. +onBits :: RandomGen g + => (BV -> BV) -- ^ The transformation of the bits. + -> Machine -- ^ THe machine. + -> Rand g Machine -- ^ Action for the resulting state of the machine. +onBits transition machine@Machine{..} = noop machine { cstate = transition cstate } + + +-- | Set a bit. +setBit' :: Bool -- ^ The value. + -> Int -- ^ Which bit. + -> BV -- ^ The initial bits. + -> BV -- ^ The result. +setBit' True = flip setBit +setBit' False = flip clearBit + + +-- | Compile a gate. +compileGate :: Parameters -- ^ The formal parameters. + -> [Expression] -- ^ The expressions for the matrix elements. + -> [QBit] -- ^ Which qubits to operate on. + -> Arguments -- ^ The argument. + -> Operator -- ^ The resulting operator. +compileGate parameters expressions indices arguments = + qubitsOperator indices + $ flip (compileExpression parameters) arguments <$> expressions + + +-- | Compile an expression. +compileExpression :: Parameters -- ^ The formal parameters. + -> Expression -- ^ The expression. + -> Arguments -- ^ The argument. + -> Number -- ^ The result. +compileExpression parameters (Power x y) = \z -> ((**) `on` flip (compileExpression parameters) z) x y +compileExpression parameters (Times x y) = \z -> ((*) `on` flip (compileExpression parameters) z) x y +compileExpression parameters (Divide x y) = \z -> ((/) `on` flip (compileExpression parameters) z) x y +compileExpression parameters (Plus x y) = \z -> ((+) `on` flip (compileExpression parameters) z) x y +compileExpression parameters (Minus x y) = \z -> ((-) `on` flip (compileExpression parameters) z) x y +compileExpression parameters (Negate x) = negate . compileExpression parameters x +compileExpression parameters (Sin x) = sin . compileExpression parameters x +compileExpression parameters (Cos x) = cos . compileExpression parameters x +compileExpression parameters (Sqrt x) = sqrt . compileExpression parameters x +compileExpression parameters (Exp x) = exp . compileExpression parameters x +compileExpression parameters (Cis x) = cis . compileExpression parameters x + where cis z = cos z + (0 :+ 1) * sin z +compileExpression _ (Number x) = const x +compileExpression parameters (Variable x) = \z -> + maybe + (error $ "Undefined variable \"" ++ x ++ "\".") + (z V.!) + $ x `V.elemIndex` parameters diff --git a/src/Language/Quil/Types.hs b/src/Language/Quil/Types.hs new file mode 100644 --- /dev/null +++ b/src/Language/Quil/Types.hs @@ -0,0 +1,289 @@ +----------------------------------------------------------------------------- +-- +-- Module : $Header$ +-- Copyright : (c) 2017-18 Brian W Bush +-- License : MIT +-- +-- Maintainer : Brian W Bush +-- Stability : Stable +-- Portability : Portable +-- +-- | Types for the Quil language for quantum computing, \<\>, and generally conforming to \<\>. +-- +----------------------------------------------------------------------------- + + +{-# LANGUAGE RecordWildCards #-} + + +module Language.Quil.Types ( +-- * Machines + Machine(..) +, machine +, Definitions(..) +, Gate +, Circuit +-- * Instructions +, Instruction(..) +, CircuitInstruction(..) +, CircuitQBit(..) +, Parameter(..) +, Name +, QBit +, QVariable +, Address +, Variable +, Label +-- * Expressions +, Expression(..) +, Number +, Parameters +, Arguments +-- * Classical Bits +, BitData(..) +, toBitVector +, boolFromBitVector +, integerFromBitVector +, doubleFromBitVector +, complexFromBitVector +) where + + +import Data.Binary.IEEE754 (doubleToWord, wordToDouble) +import Data.BitVector (BV, bitVec, extract, showHex, testBit) +import Data.Complex (Complex((:+)), imagPart, realPart) +import Data.Default (Default(def)) +import Data.Monoid ((<>)) +import Data.Qubit (Operator, Wavefunction, groundState) +import Data.Vector (Vector) + + +-- | A quantum abstract machine. +data Machine = + Machine + { + qstate :: Wavefunction -- ^ The qubits. + , cstate :: BV -- ^ The classical bits + , definitions :: Definitions -- ^ Definitions of gates and circuits. + , counter :: Int -- ^ The program counter. + , halted :: Bool -- ^ Whether the machine has halted. + } + +instance Show Machine where + show Machine{..} = + unlines + [ + "Quantum state: " ++ show qstate + , "Classical state: " ++ showHex cstate + , "Program counter: " ++ show counter + , "Halted? " ++ show halted + ] + +instance Default Machine where + def = machine 1 [BoolBit False] + + +-- | Initialize a machine. +machine :: Int -- ^ The number of qubits. + -> [BitData] -- ^ The classical bits. + -> Machine -- ^ The machine. +machine n cstate' = + let + qstate = groundState n + cstate = mconcat $ toBitVector <$> cstate' + definitions = def + counter = 0 + halted = False + in + Machine{..} + + +-- | Data types for encoding as bit vectors. +data BitData = + BoolBit Bool + | IntegerBits Int Integer + | DoubleBits Double + | ComplexBits Number + deriving (Eq, Read, Show) + + +-- | Encode data as a bit vector. +toBitVector :: BitData -> BV +toBitVector (BoolBit x) = bitVec 1 $ fromEnum x +toBitVector (IntegerBits n x) = bitVec n x +toBitVector (DoubleBits x) = bitVec 64 $ doubleToWord x +toBitVector (ComplexBits x) = bitVec 64 (doubleToWord $ realPart x) <> bitVec 64 (doubleToWord $ imagPart x) + + +-- | Extract a boolean from a bit vector. +boolFromBitVector :: Int -- ^ Which bit to start from, counting from zero. + -> BV -- ^ The bit vector. + -> Bool -- ^ The boolean. +boolFromBitVector = flip testBit + + +-- | Extract an integer from a bit vector. +integerFromBitVector :: Int -- ^ Which bit to start from, counting from zero. + -> Int -- ^ How many bits to encode. + -> BV -- ^ The bit vector + -> Integer -- ^ The integer. +integerFromBitVector k n = toInteger . extract (k + n - 1) k + + +-- | Extract a double from a bit vector. +doubleFromBitVector :: Int -- ^ Which bit to start from, counting from zero. + -> BV -- ^ THe bit vector. + -> Double -- ^ The double. +doubleFromBitVector k = wordToDouble . toEnum . fromEnum . extract (k + 63) k + + +-- | Extract a complex number from a bit vector. +complexFromBitVector :: Int -- ^ Which bit to start from, counting from zero. + -> BV -- ^ THe bit vector. + -> Number -- ^ The complex number. +complexFromBitVector k x = doubleFromBitVector k x :+ doubleFromBitVector (k + 64) x + + +-- | Definitions of gates and circuits. +data Definitions = + Definitions + { + gates :: [(Name, Gate)] + , circuits :: [(Name, Circuit)] + } + +instance Default Definitions where + def = Definitions [] [] + + +-- | A gate. +type Gate = [QBit] -> Arguments -> Operator + + +-- | A circuit +type Circuit = Definitions -> [QBit] -> Arguments -> Operator + + +-- | The Quil instruction set. +data Instruction = + COMMENT String -- ^ /Does nothing./ + | RESET + | I QBit + | X QBit + | Y QBit + | Z QBit + | H QBit + | PHASE Parameter QBit + | S QBit + | T QBit + | CPHASE00 Parameter QBit QBit + | CPHASE01 Parameter QBit QBit + | CPHASE10 Parameter QBit QBit + | CPHASE Parameter QBit QBit + | RX Parameter QBit + | RY Parameter QBit + | RZ Parameter QBit + | CNOT QBit QBit + | CCNOT QBit QBit QBit + | PSWAP Parameter QBit QBit + | SWAP QBit QBit + | ISWAP QBit QBit + | CSWAP QBit QBit QBit + | CZ QBit QBit + | DEFGATE Name [Variable] [Expression] -- ^ /Not yet implemented./ + | USEGATE Name [Parameter] [QBit] -- ^ /Not yet implemented./ + | DEFCIRCUIT Name [Variable] [QVariable] [CircuitInstruction] -- ^ /Not yet implemented./ + | USECIRCUIT Name [Parameter] [QBit] -- ^ /Not yet implemented./ + | MEASURE QBit (Maybe Address) + | HALT + | WAIT -- ^ /Does nothing./ + | LABEL Label -- ^ /Not yet implemented./ + | JUMP Label -- ^ /Not yet implemented./ + | JUMP_WHEN Label Address -- ^ /Not yet implemented./ + | JUMP_UNLESS Label Address -- ^ /Not yet implemented./ + | FALSE Address + | TRUE Address + | NOT Address + | AND Address Address + | OR Address Address + | MOVE Address Address + | EXCHANGE Address Address + | NOP + | INCLUDE FilePath -- ^ /Not yet implemented./ + | PRAGMA String -- ^ /Does nothing./ + deriving (Eq, Read, Show) + + +-- | Instructions within circuit definitions. +data CircuitInstruction = + CircuitInstruction Instruction + | CircuitGate Name [Parameter] [CircuitQBit] + deriving (Eq, Read, Show) + + +-- | References to qubits within circuit definitions. +data CircuitQBit = + CircuitQBit QBit + | CircuitQVariable QVariable + deriving (Eq, Read, Show) + + +-- | Classical parameter. +data Parameter = + DynamicParameter Int (Maybe Int) + | Expression Expression + deriving (Eq, Read, Show) + + +-- | Name of a gate or circuit. +type Name = String + + +-- | Index of a qubit. +type QBit = Int + + +-- | Qubit variable name. +type QVariable = String + + +-- | Address of a classical bit. +type Address = Int + + +-- | Classical variable name. +type Variable = String + + +-- | Label for a jump target. +type Label = String + + +-- | Classical expression. +data Expression = + Power Expression Expression + | Times Expression Expression + | Divide Expression Expression + | Plus Expression Expression + | Minus Expression Expression + | Negate Expression + | Sin Expression + | Cos Expression + | Sqrt Expression + | Exp Expression + | Cis Expression + | Number Number + | Variable Variable + deriving (Eq, Read, Show) + + +-- | Complex number. +type Number = Complex Double + + +-- | Formal parameters. +type Parameters = Vector Variable + + +-- | Argument list. +type Arguments = Vector Number diff --git a/src/Test.hs b/src/Test.hs --- a/src/Test.hs +++ b/src/Test.hs @@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- -- Module : $Header$ --- Copyright : (c) 2017 Brian W Bush +-- Copyright : (c) 2017-18 Brian W Bush -- License : MIT -- -- Maintainer : Brian W Bush