diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,10 @@ # Revision history for quil +## 0.2.1.14 -- 2018-03-04 + +* execution of Quil programs +* additional test cases + ## 0.2.0.0 -- 2017-12-19 * added types for Quil diff --git a/ReadMe.md b/ReadMe.md --- a/ReadMe.md +++ b/ReadMe.md @@ -13,7 +13,7 @@ > import Control.Monad.Random (evalRandIO) > import Data.Qubit ((^^*), groundState, measure) - > import Data.Qubit.Gate (H, CNOT) + > import Data.Qubit.Gate (h, cnot) > -- Construct the Bell state. > let bell = [h 0, cnot 0 1] ^^* groundState 2 diff --git a/haquil.cabal b/haquil.cabal --- a/haquil.cabal +++ b/haquil.cabal @@ -1,5 +1,5 @@ name : haquil -version : 0.2.1.5 +version : 0.2.1.14 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.2.1.5.tar.gz +package-url : https://bitbucket.org/functionally/quil/downloads/haquil-0.2.1.14.tar.gz category : Language stability : Unstable diff --git a/src/Data/Qubit.hs b/src/Data/Qubit.hs --- a/src/Data/Qubit.hs +++ b/src/Data/Qubit.hs @@ -9,7 +9,34 @@ -- Portability : Portable -- -- | Qubits and operations on them, using the indexing conventions of \<\>. --- +-- +-- The example below 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, measure) +-- > >>> import Data.Qubit.Gate (h, cnot) +-- > +-- > -- Construct the Bell state. +-- > >>> let bell = [h 0, cnot 0 1] ^^* groundState 2 +-- > >>> bell +-- > 0.7071067811865475|00> + 0.7071067811865475|11> @ [1,0] +-- > +-- > -- Measure the Bell wavefunction. +-- > >>> bell' <- evalRandIO $ measure [1] bell +-- > >>> bell' +-- > ([(1,0)],1.0|00> @ [1,0]) +-- > +-- > -- Measure it again. +-- > >>> evalRandIO $ measure [1] bell' +-- > ([(1,0)],1.0|00> @ [1,0]) +-- > +-- > -- Measure another Bell wavefunction. +-- > >>> evalRandIO $ measure [1] bell +-- > ([(1,0)],1.0|00> @ [1,0]) +-- > +-- > -- Measure another Bell wavefunction. +-- > >>> evalRandIO $ measure [1] bell +-- > ([(1,1)],1.0|11> @ [1,0]) ----------------------------------------------------------------------------- @@ -53,19 +80,19 @@ import Control.Arrow (first, second) -import Control.Monad (replicateM) +import Control.Monad (ap, mapM, replicateM) import Control.Monad.Random.Class (fromList) import Control.Monad.Random.Lazy (Rand, RandomGen) -import Data.Complex (Complex(..), magnitude) +import Data.Complex (Complex(..), conjugate, magnitude) import Data.Function (on) import Data.Int.Util (ilog2, isqrt) import Data.List (elemIndex, groupBy, intersect, intercalate, sortBy) import Data.Maybe (catMaybes) import Numeric.LinearAlgebra.Array ((.*)) -import Numeric.LinearAlgebra.Array.Util (Idx(iName), asScalar, coords, dims, order, outers, renameExplicit, reorder) -import Numeric.LinearAlgebra.Tensor (Tensor, Variant(..), listTensor, switch) +import Numeric.LinearAlgebra.Array.Util (Idx(iName), asScalar, coords, dims, mapArray, order, outers, renameExplicit, reorder, setType) +import Numeric.LinearAlgebra.Tensor (Tensor, Variant(..), contrav, listTensor, switch) -import qualified Data.Vector.Storable as V (toList) +import qualified Data.Vector.Storable as V (map, toList) -- | States of a quibit. @@ -90,12 +117,25 @@ names = fmap iName . dims --- | Prefixes for 'Tensor' indices. -indexPrefix :: Variant -> Char -indexPrefix Contra = 'm' -indexPrefix Co = 'n' +-- | Prefixes for 'Tensor' variants. +variantPrefix :: Variant -> Char +variantPrefix Contra = 'm' +variantPrefix Co = 'n' +-- | 'Tensor' variants for index prefixes. +prefixVariant :: String -> Variant +prefixVariant ('m' : _) = Contra +prefixVariant ('n' : _) = Co +prefixVariant _ = error "Unexpected index." + + +prefixDimension :: String -> Int +prefixDimension ('m' : _) = 2 +prefixDimension ('n' : _) = -2 +prefixDimension _ = error "Unexpected index." + + -- | 'Tensor' index for a collection of qubits. indexLabels :: Variant -- ^ Whether contravariant or covariant. -> [QIndex] -- ^ Indices of the qubits. @@ -108,7 +148,7 @@ Contra -> 0 Co -> n in - zipWith (\k v -> (show k, indexPrefix variant : show v)) [(1+o)..] $ reverse indices + zipWith (\k v -> (show k, variantPrefix variant : show v)) [(1+o)..] $ reverse indices -- | 'Tensor' index for a wavefunction. @@ -132,6 +172,7 @@ showAmplitude (a :+ b) | b == 0 = show a | a == 0 = show b ++ "i" + | b < 0 = "(" ++ show a ++ show b ++ "i)" | otherwise = "(" ++ show a ++ "+" ++ show b ++ "i)" @@ -147,16 +188,16 @@ -> a -- ^ What to show. -> String -- ^ The string respresentation. showTensor toTensor format x = - let - x' = canonicalOrder $ toTensor x - n = order x' - in - (++ (show $ tensorIndices x')) - . (++ " @ ") - . intercalate " + " - . fmap (format n) - . filter ((/= 0) . snd) - $ tensorAmplitudes x' + let + x' = canonicalOrder $ toTensor x + n = order x' + in + (++ (show $ tensorIndices x')) + . (++ " @ ") + . intercalate " + " + . fmap (format n) + . filter ((/= 0) . snd) + $ tensorAmplitudes x' -- | Indices in a tensor. @@ -164,19 +205,39 @@ -> [QIndex] -- ^ The qubit indices. tensorIndices = fmap (read . tail) - . filter ((== indexPrefix Contra) . head) + . filter ((== variantPrefix Contra) . head) . names -- | Transpose a tensor to canonical order. canonicalOrder :: Tensor Amplitude -> Tensor Amplitude canonicalOrder x = - let - f (v : i) (v' : i') = (v, - read i :: Int) `compare` (v', - read i') - f _ _ = undefined - in - reorder (sortBy f $ names x) x - + if False + then let -- See . + n = order x + f (v : i) (v' : i') = (v, - read i :: Int) `compare` (v', - read i') + f _ _ = undefined + ns = names x + ns' = sortBy f ns + Just permutation = (mapM . flip elemIndex) ns ns' + permute y = map (y !!) permutation + x' = + renameExplicit (zip (show <$> ([1..] :: [Int])) ns') + . listTensor (prefixDimension <$> ns') + . fmap snd + . sortBy (compare `on` fst) + . fmap (first permute) + . zip (replicateM n [(minBound::QState)..maxBound]) + . V.toList + $ coords x + in + foldl (flip $ ap setType prefixVariant) (contrav x') ns' + else let + f (v : i) (v' : i') = (v, - read i :: Int) `compare` (v', - read i') + f _ _ = undefined + in + reorder (sortBy f $ names x) x + -- | Amplitudes in a tensor. tensorAmplitudes :: Tensor Amplitude -- ^ The tensor. @@ -231,7 +292,7 @@ -> Wavefunction -- ^ The wavefunction for the qubit. qubit index (a0, a1) = Wavefunction - . renameExplicit [("1", indexPrefix Contra : show index)] + . renameExplicit [("1", variantPrefix Contra : show index)] $ listTensor [2] [a0, a1] @@ -345,8 +406,8 @@ mult :: Tensor Amplitude -> Tensor Amplitude -> Tensor Amplitude mult x y = let - lft = filter ((== indexPrefix Co ) . head) $ names x - rght = filter ((== indexPrefix Contra) . head) $ names y + lft = filter ((== variantPrefix Co ) . head) $ names x + rght = filter ((== variantPrefix Contra) . head) $ names y cmmn = fmap tail lft `intersect` fmap tail rght x' = renameExplicit [(i, '@' : tail i) | i <- filter ((`elem` cmmn) . tail) lft ] x y' = renameExplicit [(i, '@' : tail i) | i <- filter ((`elem` cmmn) . tail) rght] y @@ -427,7 +488,7 @@ ] z = p .* y in - Wavefunction $ z / sqrt (z * switch z) + Wavefunction $ z / sqrt (mapArray (V.map conjugate) z * switch z) -- | Measure qubits in a wavefunction. @@ -446,4 +507,4 @@ -- | The total probability for the wave function, which should be 1. wavefunctionProbability :: Wavefunction -> Amplitude -wavefunctionProbability (Wavefunction x) = asScalar $ x * switch x +wavefunctionProbability (Wavefunction x) = asScalar $ mapArray (V.map conjugate) x * switch x diff --git a/src/Language/Quil/Execute.hs b/src/Language/Quil/Execute.hs --- a/src/Language/Quil/Execute.hs +++ b/src/Language/Quil/Execute.hs @@ -10,6 +10,33 @@ -- -- | Executing Quil programs. -- +-- This example makes measurements on a prepared state. +-- +-- > >>> import Language.Quil.Execute +-- > >>> import Language.Quil.Types +-- > +-- > -- Run a simple program and examine the quantum and classical states.. +-- > >>> let program = [H 0, CNOT 0 1, RX (Expression . Number $ pi/4) 1] +-- > >>> runProgramWithStdRandom 2 [BoolBit False] program +-- > Quantum state: 0.6532814824381882|00> + -0.27059805007309845i|01> + -0.27059805007309845i|10> + 0.6532814824381882|11> @ [1,0] +-- > Classical state: 0x0 [1] +-- > Program counter: 3 +-- > Halted? False +-- > +-- > -- Add measurement to the program and re-run it. +-- > >>> let program' = program ++ [MEASURE 0 (Just 0)] +-- > >>> runProgramWithStdRandom 2 [BoolBit False] program' +-- > Quantum state: 0.9238795325112867|00> + -0.3826834323650897i|10> @ [1,0] +-- > Classical state: 0x0 [1] +-- > Program counter: 4 +-- > Halted? False +-- > +-- > -- Run the program again. +-- > >>> runProgramWithStdRandom 2 [BoolBit False] program' +-- > Quantum state: -0.3826834323650897i|01> + 0.9238795325112867|11> @ [1,0] +-- > Classical state: 0x1 [1] +-- > Program counter: 4 +-- > Halted? False ----------------------------------------------------------------------------- @@ -29,10 +56,10 @@ ) where -import Control.Monad (foldM) +import Control.Monad (foldM, join) import Control.Monad.Random.Lazy (Rand, RandomGen, evalRand, evalRandIO) -import Data.Bits (clearBit, complementBit, setBit, testBit) -import Data.BitVector (BV) +import Data.Bits (complementBit, setBit, testBit) +import Data.BitVector (BV, size) import Data.Complex (Complex((:+))) import Data.Function (on) import Data.Qubit (Operator, Wavefunction, (^*), groundState, measure, qubitsOperator, wavefunctionOrder) @@ -48,7 +75,7 @@ runProgramWithStdGen :: StdGen -- ^ The random number generator. -> Int -- ^ The number of qubits. -> [BitData] -- ^ The classical bits. - -> [Instruction] -- ^ The instructions + -> [Instruction] -- ^ The instructions. -> Machine -- ^ The resulting state of the machine. runProgramWithStdGen stdGen n cstate' instructions = runProgram n cstate' instructions `evalRand` stdGen @@ -56,7 +83,7 @@ -- | 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 + -> [Instruction] -- ^ The instructions. -> IO Machine -- ^ Action for the resulting state of the machine. runProgramWithStdRandom n cstate' instructions = evalRandIO $ runProgram n cstate' instructions @@ -65,14 +92,14 @@ runProgram :: RandomGen g => Int -- ^ The number of qubits. -> [BitData] -- ^ The classical bits. - -> [Instruction] -- ^ The instructions + -> [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 + => [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) @@ -204,7 +231,13 @@ => (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 } +onBits transition machine@Machine{..} = + let + cstate' = transition cstate + in + if size cstate == size cstate' + then noop machine { cstate = transition cstate } + else error "Cannot enlarge tne number of classical bits." -- | Set a bit. @@ -213,7 +246,7 @@ -> BV -- ^ The initial bits. -> BV -- ^ The result. setBit' True = flip setBit -setBit' False = flip clearBit +setBit' False = flip (join . (complementBit .) . setBit) -- See . -- | Compile a gate. @@ -230,7 +263,7 @@ -- | Compile an expression. compileExpression :: Parameters -- ^ The formal parameters. -> Expression -- ^ The expression. - -> Arguments -- ^ The argument. + -> Arguments -- ^ The arguments. -> 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 diff --git a/src/Language/Quil/Types.hs b/src/Language/Quil/Types.hs --- a/src/Language/Quil/Types.hs +++ b/src/Language/Quil/Types.hs @@ -43,6 +43,7 @@ , BitData(..) , toBitVector , boolFromBitVector +, finiteBitsFromBitVector , integerFromBitVector , doubleFromBitVector , complexFromBitVector @@ -50,12 +51,15 @@ import Data.Binary.IEEE754 (doubleToWord, wordToDouble) -import Data.BitVector (BV, bitVec, extract, showHex, testBit) +import Data.BitVector (BV, bitVec, extract, showHex, size, testBit) +import Data.Bits (FiniteBits(finiteBitSize)) import Data.Complex (Complex((:+)), imagPart, realPart) import Data.Default (Default(def)) +import Data.Int (Int8, Int16, Int32, Int64) import Data.Monoid ((<>)) import Data.Qubit (Operator, Wavefunction, groundState) import Data.Vector (Vector) +import Data.Word (Word8, Word16, Word32, Word64) -- | A quantum abstract machine. @@ -63,7 +67,7 @@ Machine { qstate :: Wavefunction -- ^ The qubits. - , cstate :: BV -- ^ The classical bits + , cstate :: BV -- ^ The classical bits. , definitions :: Definitions -- ^ Definitions of gates and circuits. , counter :: Int -- ^ The program counter. , halted :: Bool -- ^ Whether the machine has halted. @@ -74,7 +78,7 @@ unlines [ "Quantum state: " ++ show qstate - , "Classical state: " ++ showHex cstate + , "Classical state: " ++ showHex cstate ++ " [" ++ show (size cstate) ++ "]" , "Program counter: " ++ show counter , "Halted? " ++ show halted ] @@ -101,6 +105,14 @@ -- | Data types for encoding as bit vectors. data BitData = BoolBit Bool + | IntBits8 Int8 + | IntBits16 Int16 + | IntBits32 Int32 + | IntBits64 Int64 + | WordBits8 Word8 + | WordBits16 Word16 + | WordBits32 Word32 + | WordBits64 Word64 | IntegerBits Int Integer | DoubleBits Double | ComplexBits Number @@ -109,10 +121,18 @@ -- | Encode data as a bit vector. toBitVector :: BitData -> BV -toBitVector (BoolBit x) = bitVec 1 $ fromEnum x -toBitVector (IntegerBits n x) = bitVec n x +toBitVector (BoolBit x) = bitVec 1 $ fromEnum x +toBitVector (IntBits8 x) = bitVec 8 $ toInteger x +toBitVector (IntBits16 x) = bitVec 16 $ toInteger x +toBitVector (IntBits32 x) = bitVec 32 $ toInteger x +toBitVector (IntBits64 x) = bitVec 64 $ toInteger x +toBitVector (WordBits8 x) = bitVec 8 $ toInteger x +toBitVector (WordBits16 x) = bitVec 16 $ toInteger x +toBitVector (WordBits32 x) = bitVec 32 $ toInteger x +toBitVector (WordBits64 x) = bitVec 64 $ toInteger 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) +toBitVector (ComplexBits x) = bitVec 64 (doubleToWord $ realPart x) <> bitVec 64 (doubleToWord $ imagPart x) -- | Extract a boolean from a bit vector. @@ -122,11 +142,22 @@ boolFromBitVector = flip testBit +-- | Extract a finite bits from a bit vector. +finiteBitsFromBitVector :: (Integral a, FiniteBits a) + => Int -- ^ Which bit to start from, counting from zero. + -> BV -- ^ The bit vector. + -> a -- ^ The finite bits. +finiteBitsFromBitVector k v = + let + y = fromIntegral . toInteger $ extract (k + finiteBitSize y - 1) k v + in + y + -- | 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. + -> Int -- ^ How many bits to encode. + -> BV -- ^ The bit vector + -> Integer -- ^ The integer (unsigned). integerFromBitVector k n = toInteger . extract (k + n - 1) k @@ -134,14 +165,14 @@ 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 +doubleFromBitVector k = wordToDouble . fromIntegral . 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 +complexFromBitVector k x = doubleFromBitVector (k + 64) x :+ doubleFromBitVector k x -- | Definitions of gates and circuits. diff --git a/src/Test.hs b/src/Test.hs --- a/src/Test.hs +++ b/src/Test.hs @@ -14,6 +14,7 @@ ----------------------------------------------------------------------------- +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-missing-signatures #-} @@ -25,20 +26,38 @@ import Control.Monad (replicateM) +import Control.Monad.Random.Lazy (evalRandIO) +import Data.BitVector (BV) +import Data.Bits (bit, complementBit, setBit, testBit, xor) import Data.Complex (Complex(..), cis, magnitude) import Data.Int.Util (ilog2) import Data.Qubit (QState(..), (^*), groundState, pureQubit, pureState, qubit, qubits, rawWavefunction, wavefunctionAmplitudes, wavefunctionIndices, wavefunctionOrder) +import Language.Quil.Execute (compileExpression, executeInstruction, runProgramWithStdRandom) +import Language.Quil.Types (Address, BitData(..), Expression(..), Instruction(..), Machine(..), Parameter(..), boolFromBitVector, complexFromBitVector, doubleFromBitVector, finiteBitsFromBitVector, integerFromBitVector, machine, toBitVector) import Numeric.LinearAlgebra.Array ((.*)) -import Numeric.LinearAlgebra.Array.Util (coords, scalar) +import Numeric.LinearAlgebra.Array.Util (asScalar, coords, scalar) +import Numeric.LinearAlgebra.Tensor (switch) import Test.QuickCheck.All (quickCheckAll) +import Test.QuickCheck.Monadic (assert, monadicIO, run) +import Test.QuickCheck.Property (Property) import System.Exit (exitFailure, exitSuccess) import qualified Data.Qubit.Gate as G +import qualified Data.Vector as V (empty, fromList) import qualified Data.Vector.Storable as V (toList) -- Helper functions. +p = Expression . Number + +clearBit x k = -- See . + if testBit x k + then x `xor` bit k + else x + +few = (+ 1) . (`mod` 10) + i = scalar $ 0 :+ 1 cos' = scalar . (:+ 0) . cos @@ -54,6 +73,11 @@ (~~~) = (and .) . zipWith (\x y -> magnitude (x - y) <= epsilon) +(~=~) x y = + let + z = rawWavefunction x - rawWavefunction y + in + magnitude (asScalar $ z * switch z) < epsilon -- Wavefunction tests. @@ -324,6 +348,277 @@ && g b101 ~~ b110 && g b110 ~~ b101 && g b111 ~~ b111 + +-- Bit data. + +prop_bitdata_bool x = + x == boolFromBitVector 0 (toBitVector $ BoolBit x) + +prop_bitdata_int8 x = + x == finiteBitsFromBitVector 0 (toBitVector $ IntBits8 x) + +prop_bitdata_int16 x = + x == finiteBitsFromBitVector 0 (toBitVector $ IntBits16 x) + +prop_bitdata_int32 x = + x == finiteBitsFromBitVector 0 (toBitVector $ IntBits32 x) + +prop_bitdata_int64 x = + x == finiteBitsFromBitVector 0 (toBitVector $ IntBits64 x) + +prop_bitdata_word8 x = + x == finiteBitsFromBitVector 0 (toBitVector $ WordBits8 x) + +prop_bitdata_word16 x = + x == finiteBitsFromBitVector 0 (toBitVector $ WordBits16 x) + +prop_bitdata_word32 x = + x == finiteBitsFromBitVector 0 (toBitVector $ WordBits32 x) + +prop_bitdata_word64 x = + x == finiteBitsFromBitVector 0 (toBitVector $ WordBits64 x) + +prop_bitdata_integer x = + x < 0 || x == integerFromBitVector 0 n (toBitVector $ IntegerBits n x) + where + n = if x == 0 then 1 else fromIntegral (ilog2 x + 1) + +prop_bitdata_double x = + x == doubleFromBitVector 0 (toBitVector $ DoubleBits x) + +prop_bitdata_complex x = + x == complexFromBitVector 0 (toBitVector $ ComplexBits x) + + +-- Expressions. + +prop_expression_power x y = + x ** y == compileExpression V.empty (Power (Number x) (Number y)) V.empty + +prop_expression_times x y = + x * y == compileExpression V.empty (Times (Number x) (Number y)) V.empty + +prop_expression_divide x y = + y == 0 || x / y == compileExpression V.empty (Divide (Number x) (Number y)) V.empty + +prop_expression_plus x y = + x + y == compileExpression V.empty (Plus (Number x) (Number y)) V.empty + +prop_expression_minus x y = + x - y == compileExpression V.empty (Minus (Number x) (Number y)) V.empty + +prop_expression_negate x = + - x == compileExpression V.empty (Negate $ Number x) V.empty + +prop_expression_sin x = + sin x == compileExpression V.empty (Sin $ Number x) V.empty + +prop_expression_cos x = + cos x == compileExpression V.empty (Cos $ Number x) V.empty + +prop_expression_sqrt x = + sqrt x == compileExpression V.empty (Sqrt $ Number x) V.empty + +prop_expression_exp x = + exp x == compileExpression V.empty (Exp $ Number x) V.empty + +prop_expression_cis x = + cis x == compileExpression V.empty (Cis .Number $ x :+ 0) V.empty + +prop_expression_number x = + x == compileExpression V.empty (Number x) V.empty + +prop_expression_variable x y z w = + y == compileExpression (V.fromList [x, z]) (Variable x) (V.fromList [y, w]) + + +-- Classical bits. + +classicalSingle :: (Address -> Instruction) -> (BV -> Int -> BV) -> Integer -> Int -> Property +classicalSingle g f x k = + monadicIO + $ do + let + n = if x <= 0 then 1 else fromIntegral (ilog2 x + 1) + k' = k `mod` n + m = machine 1 [IntegerBits n x] + m' <- run . evalRandIO $ executeInstruction (g k') m + assert $ x < 0 || f (cstate m) k' == cstate m' + +classicalDouble :: (Address -> Address -> Instruction) -> (BV -> Int -> Int -> BV) -> Integer -> Int -> Int -> Property +classicalDouble g f x k l = + monadicIO + $ do + let + n = if x <= 0 then 1 else fromIntegral (ilog2 x + 1) + k' = k `mod` n + l' = l `mod` n + m = machine 1 [IntegerBits n x] + m' <- run . evalRandIO $ executeInstruction (g k' l') m + assert $ x < 0 || f (cstate m) k' l' == cstate m' + +prop_classical_false = + classicalSingle FALSE clearBit + +prop_classical_true = + classicalSingle TRUE setBit + +prop_classical_not = + classicalSingle NOT complementBit + +prop_classical_and = + classicalDouble AND + $ \bv k l -> + if testBit bv k && testBit bv l + then bv `setBit` l + else bv `clearBit` l + + +prop_classical_or = + classicalDouble OR + $ \bv k l -> + if testBit bv k || testBit bv l + then bv `setBit` l + else bv `clearBit` l + +prop_classical_move = + classicalDouble MOVE + $ \bv k l -> + if testBit bv k + then bv `setBit` l + else bv `clearBit` l + +prop_classical_exchange = + classicalDouble EXCHANGE + $ \bv k l -> + case (testBit bv k, testBit bv l) of + (False, True ) -> bv `setBit` k `clearBit` l + (True , False) -> bv `clearBit` k `setBit` l + _ -> bv + + +-- Quantum bits. + +prop_quantum_reset n = + monadicIO + $ do + let n' = few n + Machine{..} <- run $ runProgramWithStdRandom n' [] [RESET] + assert $ qstate == groundState n' + +prop_quantum_one = + monadicIO + $ do + Machine{..} <- + run + $ runProgramWithStdRandom 1 [IntBits8 0] + [ + RX (p $ pi/2) 0 + , T 0 + , H 0 + , S 0 + , RY (p 0.2) 0 + , I 0 + , PHASE (p 0.3) 0 + ] + assert $ qstate ~=~ qubits [ + 0.8845856219 :+ (-0.3664073617) + , (-0.2872987275) :+ 0.0267088763 + ] + +prop_quantum_two = + monadicIO + $ do + Machine{..} <- + run + $ runProgramWithStdRandom 2 [IntBits8 0] + [ + RX (p $ pi/2) 0 + , T 1 + , H 0 + , S 0 + , RY (p 0.2) 1 + , I 0 + , PHASE (p 0.3) 0 + ] + assert $ qstate ~=~ qubits [ + 0.4975020826 :+ (-0.4975020826) + , (-0.6223038112) :+ 0.3282599747 + , 0.0499167083 :+ (-0.0499167083) + , (-0.0624386488) :+ 0.0329358569 + ] + +prop_quantum_three = + monadicIO + $ do + Machine{..} <- + run + $ runProgramWithStdRandom 3 [IntBits8 0] + [ + RX (p 0.1) 0 + , RY (p 0.2) 1 + , H 0 + , RZ (p 0.3) 2 + , PSWAP (p 0.4) 2 1 + , CSWAP 1 0 2 + , H 1 + ] + assert $ qstate ~=~ qubits [ + 0.4875851636 :+ (-0.0988384058) + , 0.4950166445 :+ (-0.0496673327) + , 0.4875851636 :+ (-0.0988384058) + , 0.4950166445 :+ (-0.0496673327) + , 0.0489216975 :+ 0.009916919 + , 0.0476872529 :+ 0.014751396 + , 0.0489216975 :+ 0.009916919 + , 0.0476872529 :+ 0.014751396 + ] + +prop_quantum_four = + monadicIO + $ do + Machine{..} <- + run + $ runProgramWithStdRandom 4 [IntBits8 0] + [ + CPHASE00 (p 0.1) 0 1 + , H 3 + , CPHASE01 (p 0.2) 2 3 + , CCNOT 3 0 1 + , CPHASE10 (p 0.3) 2 1 + , ISWAP 3 2 + , PHASE (p 0.5) 3 + , CPHASE (p 0.4) 3 0 + , Z 3 + , CZ 1 3 + ] + assert $ qstate ~=~ qubits [ + 0.7035741926 :+ 0.0705928859 -- |0000> + , 0 + , 0 + , 0 + , (-0.2089643421) :+ 0.6755249098 -- |0100> + , 0 + , 0 + , 0 + , 0 + , 0 + , 0 + , 0 + , 0 + , 0 + , 0 + , 0 + ] + +prop_quantum_measure = + monadicIO + $ do + Machine{..} <- + run + $ runProgramWithStdRandom 2 [IntBits8 0] [H 0, CNOT 0 1, MEASURE 1 (Just 2)] + assert $ cstate == toBitVector (IntBits8 0) && qstate ~=~ qubits [1, 0, 0, 0] + || cstate == toBitVector (IntBits8 4) && qstate ~=~ qubits [0, 0, 0, 1] -- Run tests.